Skip to content

GitLab

Commit 868014cc authored by ashbre's avatar ashbre
Browse files

Adding structure to namelists and fortran files and other small files

parent ed6b5111
Hide whitespace changes
Inline Side-by-side
Showing with 794 additions and 0 deletions
NAMELISTS_AND_FORTRAN_FILES/f_files/tide_FES14.h90 0 → 100755
View file @ 868014cc
!!----------------------------------------------------------------------
!! History : 3.2 ! 2007 (O. Le Galloudec) Original code
!!----------------------------------------------------------------------
!! TIDES ADDED ! 2017 (Nico Bruneau)
!! Following this document that seems to match implemented code
!! https://docs.lib.noaa.gov/rescue/cgs_specpubs/QB275U35no981924.pdf
!! see page 189 for some proposed values
!!
!! The convention which seems to have been chosen is the Shureman one and
!! not the Cartwright and Tayer (1971)
!! This is probably due to the fact the Schureman has a solar calendar
!! while Cartwright and Tayer is based on a lunar calendar
!!
!! Therefore the coefficient are not the Doodson number but the one
!! defined by Schureman. For example :
!! M2 : Doodson : 2 0 0 0 0 0
!! Schureman : 2 -2 2 0 0 0
!!
!! Components 1-34 are for FES 2014
!! Components >= 35 are the one that were initially present in NEMO and not in FES14
!! keep in mind than equitide coefficient have been ajusted for the
!! 34 FES 2014 constituents
!!
!! The different coefficient are as follows
!! - nt = T = Number of Julian centuries (36625 days) from Greenwich mean noon on December 31, 1899.
!! = Hour angle of mean sun
!! - ns = s = mean longitude of the moon
!! - nh = h = mean longitude of the sun
!! - np = p = mean longitude of the lunar perigee
!! - np1 = p1 = mean longitude of the solar perigee
!! - shift appears in table as a bias in degree
!! - nksi Coefficient for the longitude in moon's orbit of lunar intersection
!! - nu0 Coefficient for the right ascension of lunar intersection
!! - nu1 Coefficient for the term in argument of lunisolar constituent K1
!! - nu2 Coefficient for the term in argument of lunisolar constituent K2
!! - R = ???
!! - Formula = Nodal factor function; see the table of Schureman. Implemented in tide_mod.F90
!!
!! The equitide parameter seems to be the equilibrium tide amplitude corrected
!! with the C_n^m coefficient: see Cartwright and Tayer (1971) equation 12
!! and Table 2
!! As an example in their Table 4c (p66), M2 (200000) has an amplitude of
!! around 0.63186 m
!! Table 2, give us a correction of m = 2, n = 2 (semi-diurnal)
!! 0.63186*3*sqrt( 5 / 96 / pi ) = 0.24407
!! very close to the one define originally here : 0.242297
!! Third order terms are neglected
!!
!! So to correct (to match what is implemented in sbctide.F90 - take care CT71 uses co-latitude):
!! - long wave : Amplitude from CT71 * [ -1 * sqrt( 5 / 4 / pi ) ]
!! - diurnal : Amplitude from CT71 * [ -3/2 * sqrt( 5 / 24 / pi ) ]
!! - semi-diur : Amplitude from CT71 * [ 3 * sqrt( 5 / 96 / pi ) ]
!!
!! ATTENTION: convention seems to be to have a positive coefficient and a 180 shift to
!! represent negative value. to be confirmed though.
!!
!! All equtide were computed using the last epocs from Cartwright and Tayer (1971) multiply by
!! the corresponding coefficient of their table 2
!!
!! nutide is used to compute tide potential - it uses a different formulation depending of nutide
!! see sbctide.F90 in function tide_init_potential
!!
!! Some random note
!! in cnes fes tool:
!! Msf has nksi = 2 and nnu0 = -2 which is reverse from Schureman (I kept the Schureman one)
!!
!!----------------------------------------------------------------------
!
! !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !!
! !! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !!
!
! Long Period Tides
Wave( 1) = tide( 'SA' , 0.003103 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave( 2) = tide( 'SSA' , 0.019523 , 0 , 0 , 0 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave( 3) = tide( 'MM' , 0.022191 , 0 , 0 , 1 , 0 , -1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 73 )
Wave( 4) = tide( 'MF' , 0.042023 , 0 , 0 , 2 , 0 , 0 , 0 , 0 , -2 , 0 , 0 , 0 , 0 , 74 )
Wave( 5) = tide( 'MTM' , 0.008042 , 0 , 0 , 3 , 0 , -1 , 0 , 0 , -2 , 0 , 0 , 0 , 0 , 74 )
Wave( 6) = tide( 'MSF' , 0.003671 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , -2 , 2 , 0 , 0 , 0 , 78 )
Wave( 7) = tide( 'MSQM' , 0.001293 , 0 , 0 , 4 , -2 , 0 , 0 , 0 , -2 , 0 , 0 , 0 , 0 , 74 )
!
! Diurnal Tides
Wave( 8) = tide( 'K1' ,-0.142442 , 1 , 1 , 0 , 1 , 0 , 0 , -90 , 0 , 0 , -1 , 0 , 0 , 227 )
Wave( 9) = tide( 'O1' , 0.101277 , 1 , 1 , -2 , 1 , 0 , 0 , +90 , 2 , -1 , 0 , 0 , 0 , 75 )
Wave(10) = tide( 'Q1' , 0.019383 , 1 , 1 , -3 , 1 , 1 , 0 , +90 , 2 , -1 , 0 , 0 , 0 , 75 )
Wave(11) = tide( 'P1' , 0.047145 , 1 , 1 , 0 , -1 , 0 , 0 , +90 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave(12) = tide( 'S1' ,-0.001116 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave(13) = tide( 'J1' ,-0.007961 , 1 , 1 , 1 , 1 , -1 , 0 , -90 , 0 , -1 , 0 , 0 , 0 , 76 )
!
! Semi-Diurnal Tides
Wave(14) = tide( 'M2' , 0.244083 , 2 , 2 , -2 , 2 , 0 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(15) = tide( 'N2' , 0.046720 , 2 , 2 , -3 , 2 , 1 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(16) = tide( 'S2' , 0.113565 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave(17) = tide( 'K2' , 0.030875 , 2 , 2 , 0 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , -2 , 0 , 235 )
Wave(18) = tide( 'L2' , 0.006903 , 2 , 2 , -1 , 2 , -1 , 0 , +180 , 2 , -2 , 0 , 0 , 0 , 215 )
Wave(19) = tide( 'T2' , 0.006644 , 2 , 2 , 0 , -1 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave(20) = tide( 'R2' , 0.000950 , 2 , 2 , 0 , 1 , 0 , -1 , +180 , 2 , 0 , 0 , 0 , 0 , 0 )
!
Wave(21) = tide( 'MU2' , 0.007451 , 2 , 2 , -4 , 4 , 0 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(22) = tide( 'NU2' , 0.008873 , 2 , 2 , -3 , 4 , -1 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(23) = tide( '2N2' , 0.006176 , 2 , 2 , -4 , 2 , 2 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(24) = tide( 'MKS2' , 0.000000 , 2 , 2 , -2 , 4 , 0 , 0 , 0 , 2 , -2 , 0 , -2 , 0 , 4 )
Wave(25) = tide( 'LA2' , 0.001800 , 2 , 2 , -1 , 0 , 1 , 0 , +180 , 2 , -2 , 0 , 0 , 0 , 78 )
Wave(26) = tide( 'EPS2' , 0.001796 , 2 , 2 , -5 , 4 , 1 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
!
! Harmonic and others
Wave(27) = tide( 'M3' , 0.000000 , 3 , 3 , -3 , 3 , 0 , 0 , 0 , 3 , -3 , 0 , 0 , 0 , 149 )
Wave(28) = tide( 'M4' , 0.000000 , 4 , 4 , -4 , 4 , 0 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 1 )
Wave(29) = tide( 'M6' , 0.000000 , 6 , 6 , -6 , 6 , 0 , 0 , 0 , 6 , -6 , 0 , 0 , 0 , 18 )
Wave(30) = tide( 'M8' , 0.000000 , 8 , 8 , -8 , 8 , 0 , 0 , 0 , 8 , -8 , 0 , 0 , 0 , 20 )
Wave(31) = tide( 'N4' , 0.000000 , 4 , 4 , -6 , 4 , 2 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 1 )
Wave(32) = tide( 'S4' , 0.000000 , 4 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
Wave(33) = tide( 'MN4' , 0.000000 , 4 , 4 , -5 , 4 , 1 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 1 )
Wave(34) = tide( 'MS4' , 0.000000 , 4 , 4 , -2 , 2 , 0 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 78 )
!
NAMELISTS_AND_FORTRAN_FILES/f_files/tide_mod.F90 0 → 100755
View file @ 868014cc
MODULE tide_mod
!!======================================================================
!! *** MODULE tide_mod ***
!! Compute nodal modulations corrections and pulsations
!!======================================================================
!! History : 1.0 ! 2007 (O. Le Galloudec) Original code
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
USE phycst ! physical constant
USE daymod ! calendar
IMPLICIT NONE
PRIVATE
PUBLIC tide_harmo ! called by tideini and diaharm modules
PUBLIC tide_init_Wave ! called by tideini and diaharm modules
!--- NB - extend number of constituents for tide
# if defined key_FES14_tides
INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 34 !: maximum number of harmonic
# else
INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 19 !: maximum number of harmonic
# endif
!--- END NB
TYPE, PUBLIC :: tide
CHARACTER(LEN=4) :: cname_tide
REAL(wp) :: equitide
INTEGER :: nutide
INTEGER :: nt, ns, nh, np, np1, shift
INTEGER :: nksi, nnu0, nnu1, nnu2, R
INTEGER :: nformula
END TYPE tide
TYPE(tide), PUBLIC, DIMENSION(jpmax_harmo) :: Wave !:
REAL(wp) :: sh_T, sh_s, sh_h, sh_p, sh_p1 ! astronomic angles
REAL(wp) :: sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R !
REAL(wp) :: sh_I, sh_x1ra, sh_N !
!!----------------------------------------------------------------------
!! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)
!! $Id: tide_mod.F90 5215 2015-04-15 16:11:56Z nicolasmartin $
!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE tide_init_Wave
!! NB
# if defined key_FES14_tides
# include "tide_FES14.h90"
# else
!! END NB
# include "tide.h90"
# endif
END SUBROUTINE tide_init_Wave
SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc)
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents
INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents
REAL(wp), DIMENSION(kc), INTENT(out) :: pomega ! pulsation in radians/s
REAL(wp), DIMENSION(kc), INTENT(out) :: pvt, put, pcor !
!!----------------------------------------------------------------------
!
CALL astronomic_angle
CALL tide_pulse( pomega, ktide ,kc )
CALL tide_vuf ( pvt, put, pcor, ktide ,kc )
!
END SUBROUTINE tide_harmo
SUBROUTINE astronomic_angle
!!----------------------------------------------------------------------
!! tj is time elapsed since 1st January 1900, 0 hour, counted in julian
!! century (e.g. time in days divide by 36525)
!!----------------------------------------------------------------------
REAL(wp) :: cosI, p, q, t2, t4, sin2I, s2, tgI2, P1, sh_tgn2, at1, at2
REAL(wp) :: zqy , zsy, zday, zdj, zhfrac
!!----------------------------------------------------------------------
!
zqy = AINT( (nyear-1901.)/4. )
zsy = nyear - 1900.
!
zdj = dayjul( nyear, nmonth, nday )
zday = zdj + zqy - 1.
!
zhfrac = nsec_day / 3600.
!
!----------------------------------------------------------------------
! Sh_n Longitude of ascending lunar node
!----------------------------------------------------------------------
sh_N=(259.1560564-19.328185764*zsy-.0529539336*zday-.0022064139*zhfrac)*rad
!----------------------------------------------------------------------
! T mean solar angle (Greenwhich time)
!----------------------------------------------------------------------
sh_T=(180.+zhfrac*(360./24.))*rad
!----------------------------------------------------------------------
! h mean solar Longitude
!----------------------------------------------------------------------
sh_h=(280.1895014-.238724988*zsy+.9856473288*zday+.0410686387*zhfrac)*rad
!----------------------------------------------------------------------
! s mean lunar Longitude
!----------------------------------------------------------------------
sh_s=(277.0256206+129.38482032*zsy+13.176396768*zday+.549016532*zhfrac)*rad
!----------------------------------------------------------------------
! p1 Longitude of solar perigee
!----------------------------------------------------------------------
sh_p1=(281.2208569+.01717836*zsy+.000047064*zday+.000001961*zhfrac)*rad
!----------------------------------------------------------------------
! p Longitude of lunar perigee
!----------------------------------------------------------------------
sh_p=(334.3837214+40.66246584*zsy+.111404016*zday+.004641834*zhfrac)*rad
sh_N = MOD( sh_N ,2*rpi )
sh_s = MOD( sh_s ,2*rpi )
sh_h = MOD( sh_h, 2*rpi )
sh_p = MOD( sh_p, 2*rpi )
sh_p1= MOD( sh_p1,2*rpi )
cosI = 0.913694997 -0.035692561 *cos(sh_N)
sh_I = ACOS( cosI )
sin2I = sin(sh_I)
sh_tgn2 = tan(sh_N/2.0)
at1=atan(1.01883*sh_tgn2)
at2=atan(0.64412*sh_tgn2)
sh_xi=-at1-at2+sh_N
IF( sh_N > rpi ) sh_xi=sh_xi-2.0*rpi
sh_nu = at1 - at2
!----------------------------------------------------------------------
! For constituents l2 k1 k2
!----------------------------------------------------------------------
tgI2 = tan(sh_I/2.0)
P1 = sh_p-sh_xi
t2 = tgI2*tgI2
t4 = t2*t2
sh_x1ra = sqrt( 1.0-12.0*t2*cos(2.0*P1)+36.0*t4 )
p = sin(2.0*P1)
q = 1.0/(6.0*t2)-cos(2.0*P1)
sh_R = atan(p/q)
p = sin(2.0*sh_I)*sin(sh_nu)
q = sin(2.0*sh_I)*cos(sh_nu)+0.3347
sh_nuprim = atan(p/q)
s2 = sin(sh_I)*sin(sh_I)
p = s2*sin(2.0*sh_nu)
q = s2*cos(2.0*sh_nu)+0.0727
sh_nusec = 0.5*atan(p/q)
!
END SUBROUTINE astronomic_angle
SUBROUTINE tide_pulse( pomega, ktide ,kc )
!!----------------------------------------------------------------------
!! *** ROUTINE tide_pulse ***
!!
!! ** Purpose : Compute tidal frequencies
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents
INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents
REAL(wp), DIMENSION(kc), INTENT(out) :: pomega ! pulsation in radians/s
!
INTEGER :: jh
REAL(wp) :: zscale
REAL(wp) :: zomega_T = 13149000.0_wp
REAL(wp) :: zomega_s = 481267.892_wp
REAL(wp) :: zomega_h = 36000.76892_wp
REAL(wp) :: zomega_p = 4069.0322056_wp
REAL(wp) :: zomega_n = 1934.1423972_wp
REAL(wp) :: zomega_p1= 1.719175_wp
!!----------------------------------------------------------------------
!
zscale = rad / ( 36525._wp * 86400._wp )
!
DO jh = 1, kc
pomega(jh) = ( zomega_T * Wave( ktide(jh) )%nT &
& + zomega_s * Wave( ktide(jh) )%ns &
& + zomega_h * Wave( ktide(jh) )%nh &
& + zomega_p * Wave( ktide(jh) )%np &
& + zomega_p1* Wave( ktide(jh) )%np1 ) * zscale
END DO
!
END SUBROUTINE tide_pulse
SUBROUTINE tide_vuf( pvt, put, pcor, ktide ,kc )
!!----------------------------------------------------------------------
!! *** ROUTINE tide_vuf ***
!!
!! ** Purpose : Compute nodal modulation corrections
!!
!! ** Outputs : vt: Phase of tidal potential relative to Greenwich (radians)
!! ut: Phase correction u due to nodal motion (radians)
!! ft: Nodal correction factor
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents
INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents
REAL(wp), DIMENSION(kc), INTENT(out) :: pvt, put, pcor !
!
INTEGER :: jh ! dummy loop index
!!----------------------------------------------------------------------
!
DO jh = 1, kc
! Phase of the tidal potential relative to the Greenwhich
! meridian (e.g. the position of the fictuous celestial body). Units are radian:
pvt(jh) = sh_T * Wave( ktide(jh) )%nT &
& + sh_s * Wave( ktide(jh) )%ns &
& + sh_h * Wave( ktide(jh) )%nh &
& + sh_p * Wave( ktide(jh) )%np &
& + sh_p1* Wave( ktide(jh) )%np1 &
& + Wave( ktide(jh) )%shift * rad
!
! Phase correction u due to nodal motion. Units are radian:
put(jh) = sh_xi * Wave( ktide(jh) )%nksi &
& + sh_nu * Wave( ktide(jh) )%nnu0 &
& + sh_nuprim * Wave( ktide(jh) )%nnu1 &
& + sh_nusec * Wave( ktide(jh) )%nnu2 &
& + sh_R * Wave( ktide(jh) )%R
! Nodal correction factor:
pcor(jh) = nodal_factort( Wave( ktide(jh) )%nformula )
END DO
!
END SUBROUTINE tide_vuf
RECURSIVE FUNCTION nodal_factort( kformula ) RESULT( zf )
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kformula
!
REAL(wp) :: zf
REAL(wp) :: zs, zf1, zf2
!!----------------------------------------------------------------------
!
SELECT CASE( kformula )
!
CASE( 0 ) !== formule 0, solar waves
zf = 1.0
!
CASE( 1 ) !== formule 1, compound waves (78 x 78)
zf=nodal_factort(78)
zf = zf * zf
!
CASE ( 2 ) !== formule 2, compound waves (78 x 0) === (78)
zf1= nodal_factort(78)
zf = nodal_factort( 0)
zf = zf1 * zf
!
CASE ( 4 ) !== formule 4, compound waves (78 x 235)
zf1 = nodal_factort( 78)
zf = nodal_factort(235)
zf = zf1 * zf
!
CASE ( 5 ) !== formule 5, compound waves (78 *78 x 235)
zf1 = nodal_factort( 78)
zf = nodal_factort(235)
zf = zf * zf1 * zf1
!
CASE ( 6 ) !== formule 6, compound waves (78 *78 x 0)
zf1 = nodal_factort(78)
zf = nodal_factort( 0)
zf = zf * zf1 * zf1
!
CASE( 7 ) !== formule 7, compound waves (75 x 75)
zf = nodal_factort(75)
zf = zf * zf
!
CASE( 8 ) !== formule 8, compound waves (78 x 0 x 235)
zf = nodal_factort( 78)
zf1 = nodal_factort( 0)
zf2 = nodal_factort(235)
zf = zf * zf1 * zf2
!
CASE( 9 ) !== formule 9, compound waves (78 x 0 x 227)
zf = nodal_factort( 78)
zf1 = nodal_factort( 0)
zf2 = nodal_factort(227)
zf = zf * zf1 * zf2
!
CASE( 10 ) !== formule 10, compound waves (78 x 227)
zf = nodal_factort( 78)
zf1 = nodal_factort(227)
zf = zf * zf1
!
CASE( 11 ) !== formule 11, compound waves (75 x 0)
!!gm bug???? zf 2 fois !
zf = nodal_factort(75)
zf = nodal_factort( 0)
zf = zf * zf1
!
CASE( 12 ) !== formule 12, compound waves (78 x 78 x 78 x 0)
zf1 = nodal_factort(78)
zf = nodal_factort( 0)
zf = zf * zf1 * zf1 * zf1
!
CASE( 13 ) !== formule 13, compound waves (78 x 75)
zf1 = nodal_factort(78)
zf = nodal_factort(75)
zf = zf * zf1
!
CASE( 14 ) !== formule 14, compound waves (235 x 0) === (235)
zf = nodal_factort(235)
zf1 = nodal_factort( 0)
zf = zf * zf1
!
CASE( 15 ) !== formule 15, compound waves (235 x 75)
zf = nodal_factort(235)
zf1 = nodal_factort( 75)
zf = zf * zf1
!
CASE( 16 ) !== formule 16, compound waves (78 x 0 x 0) === (78)
zf = nodal_factort(78)
zf1 = nodal_factort( 0)
zf = zf * zf1 * zf1
!
CASE( 17 ) !== formule 17, compound waves (227 x 0)
zf1 = nodal_factort(227)
zf = nodal_factort( 0)
zf = zf * zf1
!
CASE( 18 ) !== formule 18, compound waves (78 x 78 x 78 )
zf1 = nodal_factort(78)
zf = zf1 * zf1 * zf1
!
CASE( 19 ) !== formule 19, compound waves (78 x 0 x 0 x 0) === (78)
!!gm bug2 ==>>> here identical to formule 16, a third multiplication by zf1 is missing
zf = nodal_factort(78)
zf1 = nodal_factort( 0)
zf = zf * zf1 * zf1
!
!--- NB 11/2017
CASE( 20 ) !== formule 20, compound waves ( 78 x 78 x 78 x 78 )
zf1 = nodal_factort(78)
zf = zf1 * zf1 * zf1 * zf1
!--- END NB
!
CASE( 73 ) !== formule 73
zs = sin(sh_I)
zf = (2./3.-zs*zs)/0.5021
!
CASE( 74 ) !== formule 74
zs = sin(sh_I)
zf = zs * zs / 0.1578
!
CASE( 75 ) !== formule 75
zs = cos(sh_I/2)
zf = sin(sh_I) * zs * zs / 0.3800
!
CASE( 76 ) !== formule 76
zf = sin(2*sh_I) / 0.7214
!
CASE( 77 ) !== formule 77
zs = sin(sh_I/2)
zf = sin(sh_I) * zs * zs / 0.0164
!
CASE( 78 ) !== formule 78
zs = cos(sh_I/2)
zf = zs * zs * zs * zs / 0.9154
!
CASE( 79 ) !== formule 79
zs = sin(sh_I)
zf = zs * zs / 0.1565
!
CASE( 144 ) !== formule 144
zs = sin(sh_I/2)
zf = ( 1-10*zs*zs+15*zs*zs*zs*zs ) * cos(sh_I/2) / 0.5873
!
CASE( 149 ) !== formule 149
zs = cos(sh_I/2)
zf = zs*zs*zs*zs*zs*zs / 0.8758
!
CASE( 215 ) !== formule 215
zs = cos(sh_I/2)
zf = zs*zs*zs*zs / 0.9154 * sh_x1ra
!
CASE( 227 ) !== formule 227
zs = sin(2*sh_I)
zf = sqrt( 0.8965*zs*zs+0.6001*zs*cos (sh_nu)+0.1006 )
!
CASE ( 235 ) !== formule 235
zs = sin(sh_I)
zf = sqrt( 19.0444*zs*zs*zs*zs + 2.7702*zs*zs*cos(2*sh_nu) + .0981 )
!
END SELECT
!
END FUNCTION nodal_factort
FUNCTION dayjul( kyr, kmonth, kday )
!!----------------------------------------------------------------------
!! *** THIS ROUTINE COMPUTES THE JULIAN DAY (AS A REAL VARIABLE)
!!----------------------------------------------------------------------
INTEGER,INTENT(in) :: kyr, kmonth, kday
!
INTEGER,DIMENSION(12) :: idayt, idays
INTEGER :: inc, ji
REAL(wp) :: dayjul, zyq
!
DATA idayt/0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334./
!!----------------------------------------------------------------------
!
idays(1) = 0.
idays(2) = 31.
inc = 0.
zyq = MOD( kyr-1900. , 4. )
IF( zyq == 0.) inc = 1.
DO ji = 3, 12
idays(ji)=idayt(ji)+inc
END DO
dayjul = idays(kmonth) + kday
!
END FUNCTION dayjul
!!======================================================================
END MODULE tide_mod
NAMELISTS_AND_FORTRAN_FILES/f_files/tideini.F90 0 → 100755
View file @ 868014cc
MODULE tideini
!!======================================================================
!! *** MODULE tideini ***
!! Initialization of tidal forcing
!!======================================================================
!! History : 1.0 ! 2007 (O. Le Galloudec) Original code
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers variables
USE dom_oce ! ocean space and time domain
USE phycst ! physical constant
USE daymod ! calandar
USE tide_mod !
!
USE in_out_manager ! I/O units
USE iom ! xIOs server
USE ioipsl ! NetCDF IPSL library
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
IMPLICIT NONE
PUBLIC
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide !:
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: v0tide !:
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: utide !:
REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: ftide !:
LOGICAL , PUBLIC :: ln_tide !:
LOGICAL , PUBLIC :: ln_tide_pot !:
LOGICAL , PUBLIC :: ln_tide_ramp !:
INTEGER , PUBLIC :: nb_harmo !:
INTEGER , PUBLIC :: kt_tide !:
REAL(wp), PUBLIC :: rdttideramp !:
! NB - read love number from namelist
REAL(wp), PUBLIC :: dn_love_number !:
! END NB
INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !:
!!----------------------------------------------------------------------
!! NEMO/OPA 3.5 , NEMO Consortium (2013)
!! $Id: tideini.F90 7646 2017-02-06 09:25:03Z timgraham $
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE tide_init
!!----------------------------------------------------------------------
!! *** ROUTINE tide_init ***
!!----------------------------------------------------------------------
INTEGER :: ji, jk
CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
INTEGER :: ios ! Local integer output status for namelist read
!
! NB - read love number from namelist
!NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, clname
NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, dn_love_number, clname
! END NB
!!----------------------------------------------------------------------
!
! Read Namelist nam_tide
REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides
READ ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp )
!
REWIND( numnam_cfg ) ! Namelist nam_tide in configuration namelist : Tides
READ ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 )
902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp )
IF(lwm) WRITE ( numond, nam_tide )
!
IF (ln_tide) THEN
IF (lwp) THEN
WRITE(numout,*)
WRITE(numout,*) 'tide_init : Initialization of the tidal components'
WRITE(numout,*) '~~~~~~~~~ '
WRITE(numout,*) ' Namelist nam_tide'
WRITE(numout,*) ' Use tidal components : ln_tide = ', ln_tide
WRITE(numout,*) ' Apply astronomical potential : ln_tide_pot = ', ln_tide_pot
! WRITE(numout,*) ' nb_harmo = ', nb_harmo
WRITE(numout,*) ' ln_tide_ramp = ', ln_tide_ramp
! NB - Love number
WRITE(numout,*) ' dn_love_number = ', dn_love_number
! End NB
ENDIF
ELSE
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)'
IF(lwp) WRITE(numout,*) '~~~~~~~~~ '
RETURN
ENDIF
!
CALL tide_init_Wave
!
nb_harmo=0
DO jk = 1, jpmax_harmo
DO ji = 1,jpmax_harmo
IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1
END DO
END DO
IF (ln_tide .and.lwp) WRITE(numout,*) ' nb_harmo = ', nb_harmo
! Ensure that tidal components have been set in namelist_cfg
IF( nb_harmo == 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' )
!
IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) ) &
& CALL ctl_stop('rdttideramp must be lower than run duration')
IF( ln_tide_ramp.AND.(rdttideramp<0.) ) &
& CALL ctl_stop('rdttideramp must be positive')
!
ALLOCATE( ntide(nb_harmo) )
DO jk = 1, nb_harmo
DO ji = 1, jpmax_harmo
IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN
ntide(jk) = ji
EXIT
ENDIF
END DO
END DO
!
ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), &
& utide (nb_harmo), ftide (nb_harmo) )
kt_tide = nit000
!
END SUBROUTINE tide_init
!!======================================================================
END MODULE tideini
NAMELISTS_AND_FORTRAN_FILES/p_files/scrip.patch 0 → 100755
View file @ 868014cc
--- scrip.F90 2015-10-21 14:48:33.000000000 +0100
+++ scrip_new.F90 2015-10-22 10:47:31.000000000 +0100
@@ -37,6 +37,7 @@
program scrip
!-----------------------------------------------------------------------
+#define ARGC
use kinds_mod ! module defining data types
use constants ! module for common constants
NAMELISTS_AND_FORTRAN_FILES/p_files/scripgrid.patch 0 → 100755
View file @ 868014cc
--- scripgrid.F90 2015-10-21 14:48:33.000000000 +0100
+++ scripgrid_new.F90 2015-10-22 10:47:41.000000000 +0100
@@ -1,6 +1,7 @@
! ==============================================================================
PROGRAM scripgrid
+#define ARGC
USE scripgrid_mod
NAMELISTS_AND_FORTRAN_FILES/p_files/scripinterp.patch 0 → 100755
View file @ 868014cc
--- scripinterp.F90 2015-10-22 10:38:46.000000000 +0100
+++ scripinterp_new.F90 2015-10-22 10:38:17.000000000 +0100
@@ -2,6 +2,8 @@
program scripinterp
+#define ARGC
+
use scripinterp_mod
character (char_len) :: nm_in
NAMELISTS_AND_FORTRAN_FILES/p_files/scripinterp_mod.patch 0 → 100755
View file @ 868014cc
--- scripinterp_mod.F90 (revision 5047)
+++ scripinterp_mod.F90 (working copy)
@@ -27,7 +27,7 @@
scale
integer (kind=int_kind), dimension(:), allocatable :: &
nc_xysize_id, nc_gridsize_id, nc_gridsize, &
- nc_variable_id
+ nc_variable_id, nc_extra_len
integer :: nc_lon_id, nc_lat_id, nc_array_id
character (char_len) :: &
@@ -81,7 +81,7 @@
integer (kind=int_kind), dimension(4) :: &
astart, acount, plus_one
- integer (kind=int_kind), dimension(3) :: &
+ integer (kind=int_kind), dimension(4) :: &
write_dims
integer (kind=int_kind) :: &
i1, i2, jdim, n, nx, ny, nloop, &
@@ -172,7 +172,8 @@
write_dims(1) = grid2_dims(1)
write_dims(2) = grid2_dims(2)
write_dims(3) = nloop
- call define_grid(write_dims(1:3) , 2+numv)
+ write_dims(4) = 1
+ call define_grid(write_dims(1:4) , nc_input_rank, numv+2)
astart(:) = input_start(:)
astart(3) = astart(3) - input_stride(3)
@@ -221,7 +222,8 @@
input_dimids(1), len=input_dims(1) )
call netcdf_error_handler(ncstat,"inquire_dimension")
- ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n), &
+ nc_extra_len(n) = input_dims(1)
+ ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:input_dims(1),n), &
start=(/ vstart /), stride=(/ vstride /))
call netcdf_error_handler(ncstat,"get_var")
enddo
@@ -246,7 +248,7 @@
! ==========================================================================
- subroutine define_grid(thedims, therank)
+ subroutine define_grid(thedims, therank, nvars)
!-----------------------------------------------------------------------
! - dummy variables
@@ -255,6 +257,8 @@
therank
integer (kind=int_kind), dimension(therank) :: &
thedims
+ integer (kind=int_kind) :: &
+ nvars
!-----------------------------------------------------------------------
! - local variables
@@ -275,7 +279,8 @@
allocate(nc_xysize_id(grid2_rank))
allocate(nc_gridsize_id(therank))
allocate(nc_gridsize(therank))
- allocate(nc_variable_id(therank-2))
+ allocate(nc_extra_len(nvars-2))
+ allocate(nc_variable_id(nvars-2))
!-----------------------------------------------------------------------
! - setup a NetCDF file for output
@@ -340,7 +345,7 @@
! - define copy variables array
write(6,*) 'defining copy variables'
- do n = 3,therank
+ do n = 3,nvars
ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2), &
xtype, nc_gridsize_id(n), &
nc_variable_id(n-2))
@@ -535,7 +540,7 @@
do n = 3,therank
s = scale(nc_variable_id(n-2))
thedata(:) = s*thevars(:,n-2)
- ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+ ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata(1:nc_extra_len(n-2)))
call netcdf_error_handler(ncstat,"put_var")
enddo
NAMELISTS_AND_FORTRAN_FILES/p_files/scripshape.patch 0 → 100755
View file @ 868014cc
--- scripshape.F90 2015-10-21 14:48:33.000000000 +0100
+++ scripshape_new.F90 2015-10-22 10:47:51.000000000 +0100
@@ -1,4 +1,5 @@
PROGRAM scripshape
+#define ARGC
!
! program to take output from the SCRIP weights generator
! and rearrange the data into a series of 2D fields suitable
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment