Changeset 1987 for LMDZ5/trunk/libf/dyn3d
- Timestamp:
- Feb 24, 2014, 4:05:47 PM (11 years ago)
- Location:
- LMDZ5/trunk/libf/dyn3d
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dyn3d/addfi.F
r1907 r1987 55 55 c ----------- 56 56 c 57 REAL pdt57 REAL,INTENT(IN) :: pdt ! time step for the integration (s) 58 58 c 59 REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm) 60 REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1) 59 REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind 60 REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind 61 REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature 62 REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers 63 REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa) 64 c respective tendencies (.../s) to add 65 REAL,INTENT(IN) :: pdvfi(ip1jm,llm) 66 REAL,INTENT(IN) :: pdufi(ip1jmp1,llm) 67 REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot) 68 REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm) 69 REAL,INTENT(IN) :: pdpfi(ip1jmp1) 61 70 c 62 REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm) 63 REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1) 64 c 65 LOGICAL leapf,forward 71 LOGICAL,INTENT(IN) :: leapf,forward ! not used 66 72 c 67 73 c … … 71 77 REAL xpn(iim),xps(iim),tpn,tps 72 78 INTEGER j,k,iq,ij 73 REAL qtestw, qtestt 74 PARAMETER ( qtestw = 1.0e-15 ) 75 PARAMETER ( qtestt = 1.0e-40 ) 79 REAL,PARAMETER :: qtestw = 1.0e-15 80 REAL,PARAMETER :: qtestt = 1.0e-40 76 81 77 82 REAL SSUM -
LMDZ5/trunk/libf/dyn3d/advtrac.F90
r1907 r1987 9 9 ! M.A Filiberti (04/2002) 10 10 ! 11 USE infotrac 12 USE control_mod 11 USE infotrac, ONLY: nqtot, iadv 12 USE control_mod, ONLY: iapp_tracvl, day_step 13 13 14 14 … … 30 30 ! Arguments 31 31 !------------------------------------------------------------------- 32 INTEGER,INTENT(OUT) :: iapptrac 33 REAL,INTENT(IN) :: pbaru(ip1jmp1,llm) 34 REAL,INTENT(IN) :: pbarv(ip1jm,llm) 35 REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot) 36 REAL,INTENT(IN) :: masse(ip1jmp1,llm) 37 REAL,INTENT(IN) :: p( ip1jmp1,llmp1 ) 38 REAL,INTENT(IN) :: teta(ip1jmp1,llm) 39 REAL,INTENT(IN) :: pk(ip1jmp1,llm) 40 REAL,INTENT(OUT) :: flxw(ip1jmp1,llm) 41 !------------------------------------------------------------------- 32 42 ! Ajout PPM 33 43 !-------------------------------------------------------- 34 44 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm) 35 !--------------------------------------------------------36 INTEGER iapptrac37 REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)38 REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)39 REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)40 REAL pk(ip1jmp1,llm)41 REAL flxw(ip1jmp1,llm)42 43 45 !------------------------------------------------------------- 44 46 ! Variables locales -
LMDZ5/trunk/libf/dyn3d/caldyn.F
r1907 r1987 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 c5 c6 4 SUBROUTINE caldyn 7 5 $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , … … 10 8 IMPLICIT NONE 11 9 12 c=======================================================================13 c 14 cAuteur : P. Le Van15 c 16 cObjet:17 c------18 c 19 cCalcul des tendances dynamiques.20 c 21 cModif 04/93 F.Forget22 c=======================================================================10 !======================================================================= 11 ! 12 ! Auteur : P. Le Van 13 ! 14 ! Objet: 15 ! ------ 16 ! 17 ! Calcul des tendances dynamiques. 18 ! 19 ! Modif 04/93 F.Forget 20 !======================================================================= 23 21 24 c-----------------------------------------------------------------------25 c0. Declarations:26 c----------------22 !----------------------------------------------------------------------- 23 ! 0. Declarations: 24 ! ---------------- 27 25 28 26 #include "dimensions.h" … … 32 30 #include "comgeom.h" 33 31 34 cArguments:35 c----------32 ! Arguments: 33 ! ---------- 36 34 37 LOGICAL conser 35 LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics 36 INTEGER,INTENT(IN) :: itau ! time step index 37 REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind 38 REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind 39 REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature 40 REAL,INTENT(IN) :: ps(ip1jmp1) ! surface pressure 41 REAL,INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface 42 REAL,INTENT(IN) :: pk(ip1jmp1,llm) ! Exner at mid-layer 43 REAL,INTENT(IN) :: pkf(ip1jmp1,llm) ! filtered Exner 44 REAL,INTENT(IN) :: phi(ip1jmp1,llm) ! geopotential 45 REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass 46 REAL,INTENT(OUT) :: dv(ip1jm,llm) ! tendency on vcov 47 REAL,INTENT(OUT) :: du(ip1jmp1,llm) ! tendency on ucov 48 REAL,INTENT(OUT) :: dteta(ip1jmp1,llm) ! tenddency on teta 49 REAL,INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps 50 REAL,INTENT(OUT) :: w(ip1jmp1,llm) ! vertical velocity 51 REAL,INTENT(OUT) :: pbaru(ip1jmp1,llm) ! mass flux in the zonal direction 52 REAL,INTENT(OUT) :: pbarv(ip1jm,llm) ! mass flux in the meridional direction 53 REAL,INTENT(IN) :: time ! current time 38 54 39 INTEGER itau 40 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm) 41 REAL ps(ip1jmp1),phis(ip1jmp1) 42 REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm) 55 ! Local: 56 ! ------ 57 43 58 REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm) 44 REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)45 REAL dv(ip1jm,llm),du(ip1jmp1,llm)46 REAL dteta(ip1jmp1,llm),dp(ip1jmp1)47 REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)48 REAL time49 50 c Local:51 c ------52 53 59 REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1) 54 60 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm) 55 61 REAL vorpot(ip1jm,llm) 56 REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)62 REAL ecin(ip1jmp1,llm),convm(ip1jmp1,llm) 57 63 REAL bern(ip1jmp1,llm) 58 64 REAL massebxy(ip1jm,llm) … … 61 67 INTEGER ij,l 62 68 63 c-----------------------------------------------------------------------64 c Calcul des tendances dynamiques:65 c--------------------------------69 !----------------------------------------------------------------------- 70 ! Compute dynamical tendencies: 71 !-------------------------------- 66 72 73 ! compute contravariant winds ucont() and vcont 67 74 CALL covcont ( llm , ucov , vcov , ucont, vcont ) 75 ! compute pressure p() 68 76 CALL pression ( ip1jmp1, ap , bp , ps , p ) 77 ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?) 69 78 CALL psextbar ( ps , psexbarxy ) 79 ! compute mass in each atmospheric mesh: masse() 70 80 CALL massdair ( p , masse ) 81 ! compute X and Y-averages of mass, massebx() and masseby() 71 82 CALL massbar ( masse, massebx , masseby ) 83 ! compute XY-average of mass, massebxy() 72 84 call massbarxy( masse, massebxy ) 85 ! compute mass fluxes pbaru() and pbarv() 73 86 CALL flumass ( massebx, masseby , vcont, ucont ,pbaru, pbarv ) 87 ! compute dteta() , horizontal converging flux of theta 74 88 CALL dteta1 ( teta , pbaru , pbarv, dteta ) 89 ! compute convm(), horizontal converging flux of mass 75 90 CALL convmas ( pbaru, pbarv , convm ) 76 91 92 ! compute pressure variation due to mass convergence 77 93 DO ij =1, ip1jmp1 78 94 dp( ij ) = convm( ij,1 ) / airesurg( ij ) 79 95 ENDDO 80 96 97 ! compute vertical velocity w() 81 98 CALL vitvert ( convm , w ) 99 ! compute potential vorticity vorpot() 82 100 CALL tourpot ( vcov , ucov , massebxy , vorpot ) 101 ! compute rotation induced du() and dv() 83 102 CALL dudv1 ( vorpot , pbaru , pbarv , du , dv ) 103 ! compute kinetic energy ecin() 84 104 CALL enercin ( vcov , ucov , vcont , ucont , ecin ) 105 ! compute Bernouilli function bern() 85 106 CALL bernoui ( ip1jmp1, llm , phi , ecin , bern ) 107 ! compute and add du() and dv() contributions from Bernouilli and pressure 86 108 CALL dudv2 ( teta , pkf , bern , du , dv ) 87 109 … … 90 112 DO ij=1,ip1jmp1 91 113 ang(ij,l) = ucov(ij,l) + constang(ij) 92 ENDDO114 ENDDO 93 115 ENDDO 94 116 95 117 ! compute vertical advection contributions to du(), dv() and dteta() 96 118 CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta ) 97 119 98 CWARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi99 Cprobablement. Observe sur le code compile avec pgf90 3.0-1120 ! WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi 121 ! probablement. Observe sur le code compile avec pgf90 3.0-1 100 122 101 123 DO l = 1, llm 102 124 DO ij = 1, ip1jm, iip1 103 125 IF( dv(ij,l).NE.dv(ij+iim,l) ) THEN 104 cPRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',105 c, ' dans caldyn'106 cPRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)126 ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 127 ! , ' dans caldyn' 128 ! PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l) 107 129 dv(ij+iim,l) = dv(ij,l) 108 endif 109 enddo 110 enddo 111 c----------------------------------------------------------------------- 112 c Sorties eventuelles des variables de controle: 113 c ---------------------------------------------- 130 ENDIF 131 ENDDO 132 ENDDO 133 134 !----------------------------------------------------------------------- 135 ! Output some control variables: 136 !--------------------------------- 114 137 115 138 IF( conser ) THEN 116 139 CALL sortvarc 117 $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov ) 118 140 & ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov ) 119 141 ENDIF 120 142 121 RETURN122 143 END -
LMDZ5/trunk/libf/dyn3d/calfis.F
r1907 r1987 30 30 c Auteur : P. Le Van, F. Hourdin 31 31 c ......... 32 USE infotrac 33 USE control_mod 32 USE infotrac, ONLY: nqtot, niadv, tname 33 USE control_mod, ONLY: planet_type, nsplit_phys 34 34 35 35 … … 102 102 c Arguments : 103 103 c ----------- 104 LOGICAL lafin 105 106 107 REAL pvcov(iip1,jjm,llm) 108 REAL pucov(iip1,jjp1,llm) 109 REAL pteta(iip1,jjp1,llm) 110 REAL pmasse(iip1,jjp1,llm) 111 REAL pq(iip1,jjp1,llm,nqtot) 112 REAL pphis(iip1,jjp1) 113 REAL pphi(iip1,jjp1,llm) 114 c 115 REAL pdvcov(iip1,jjm,llm) 116 REAL pducov(iip1,jjp1,llm) 117 REAL pdteta(iip1,jjp1,llm) 118 REAL pdq(iip1,jjp1,llm,nqtot) 119 c 120 REAL pps(iip1,jjp1) 121 REAL pp(iip1,jjp1,llmp1) 122 REAL ppk(iip1,jjp1,llm) 123 c 124 REAL pdvfi(iip1,jjm,llm) 125 REAL pdufi(iip1,jjp1,llm) 126 REAL pdhfi(iip1,jjp1,llm) 127 REAL pdqfi(iip1,jjp1,llm,nqtot) 128 REAL pdpsfi(iip1,jjp1) 129 130 INTEGER longcles 131 PARAMETER ( longcles = 20 ) 132 REAL clesphy0( longcles ) 104 LOGICAL,INTENT(IN) :: lafin ! .true. for the very last call to physics 105 REAL,INTENT(IN):: jD_cur, jH_cur 106 REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity 107 REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity 108 REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature 109 REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used 110 REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers 111 REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential 112 REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential 113 114 REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov 115 REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov 116 REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta 117 ! NB: pdteta is used only to compute pcvgt which is in fact not used... 118 REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers 119 ! NB: pdq is only used to compute pcvgq which is in fact not used... 120 121 REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa) 122 REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa) 123 REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer 124 REAL,INTENT(IN) :: flxw(iip1,jjp1,llm) ! Vertical mass flux on dynamics grid 125 126 ! tendencies (in */s) from the physics 127 REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind 128 REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind 129 REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s) 130 REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers 131 REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s) 132 133 INTEGER,PARAMETER :: longcles = 20 134 REAL,INTENT(IN) :: clesphy0( longcles ) ! unused 133 135 134 136 … … 162 164 c 163 165 cIM diagnostique PVteta, Amip2 164 INTEGER ntetaSTD 165 PARAMETER(ntetaSTD=3) 166 REAL rtetaSTD(ntetaSTD) 167 DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !! 166 INTEGER,PARAMETER :: ntetaSTD=3 167 REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !! 168 168 REAL PVteta(ngridmx,ntetaSTD) 169 169 c 170 REAL flxw(iip1,jjp1,llm) ! Flux de masse verticale sur la grille dynamique171 170 REAL flxwfi(ngridmx,llm) ! Flux de masse verticale sur la grille physiq 172 171 c … … 174 173 REAL SSUM 175 174 176 LOGICAL firstcal, debut 177 DATA firstcal/.true./ 178 SAVE firstcal,debut 175 LOGICAL,SAVE :: firstcal=.true., debut=.true. 179 176 ! REAL rdayvrai 180 REAL, intent(in):: jD_cur, jH_cur181 177 182 178 LOGICAL tracerdyn -
LMDZ5/trunk/libf/dyn3d/dissip.F
r1907 r1987 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh ) … … 35 35 c ---------- 36 36 37 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm) 38 REAL p( ip1jmp1,llmp1 ) 39 REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm) 37 REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind 38 REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind 39 REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature 40 REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure 41 ! tendencies (.../s) on covariant winds and potential temperature 42 REAL,INTENT(OUT) :: dv(ip1jm,llm) 43 REAL,INTENT(OUT) :: du(ip1jmp1,llm) 44 REAL,INTENT(OUT) :: dh(ip1jmp1,llm) 40 45 41 46 c Local: -
LMDZ5/trunk/libf/dyn3d/leapfrog.F
r1907 r1987 12 12 use IOIPSL 13 13 #endif 14 USE infotrac 14 USE infotrac, ONLY: nqtot 15 15 USE guide_mod, ONLY : guide_main 16 USE write_field 17 USE control_mod 16 USE write_field, ONLY: writefield 17 USE control_mod, ONLY: nday, day_step, planet_type, offline, 18 & iconser, iphysiq, iperiod, dissip_period, 19 & iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins, 20 & periodav, ok_dyn_ave, output_grads_dyn 18 21 IMPLICIT NONE 19 22 … … 67 70 ! #include "clesphys.h" 68 71 69 INTEGER longcles 70 PARAMETER ( longcles = 20 ) 71 REAL clesphy0( longcles ) 72 INTEGER,PARAMETER :: longcles = 20 73 REAL,INTENT(IN) :: clesphy0( longcles ) ! not used 74 REAL,INTENT(IN) :: time_0 ! not used 75 76 c dynamical variables: 77 REAL,INTENT(INOUT) :: ucov(ip1jmp1,llm) ! zonal covariant wind 78 REAL,INTENT(INOUT) :: vcov(ip1jm,llm) ! meridional covariant wind 79 REAL,INTENT(INOUT) :: teta(ip1jmp1,llm) ! potential temperature 80 REAL,INTENT(INOUT) :: ps(ip1jmp1) ! surface pressure (Pa) 81 REAL,INTENT(INOUT) :: masse(ip1jmp1,llm) ! air mass 82 REAL,INTENT(INOUT) :: phis(ip1jmp1) ! geopotentiat at the surface 83 REAL,INTENT(INOUT) :: q(ip1jmp1,llm,nqtot) ! advected tracers 84 85 REAL p (ip1jmp1,llmp1 ) ! interlayer pressure 86 REAL pks(ip1jmp1) ! exner at the surface 87 REAL pk(ip1jmp1,llm) ! exner at mid-layer 88 REAL pkf(ip1jmp1,llm) ! filtered exner at mid-layer 89 REAL phi(ip1jmp1,llm) ! geopotential 90 REAL w(ip1jmp1,llm) ! vertical velocity 72 91 73 92 real zqmin,zqmax 74 75 c variables dynamiques76 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants77 REAL teta(ip1jmp1,llm) ! temperature potentielle78 REAL q(ip1jmp1,llm,nqtot) ! champs advectes79 REAL ps(ip1jmp1) ! pression au sol80 REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches81 REAL pks(ip1jmp1) ! exner au sol82 REAL pk(ip1jmp1,llm) ! exner au milieu des couches83 REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches84 REAL masse(ip1jmp1,llm) ! masse d'air85 REAL phis(ip1jmp1) ! geopotentiel au sol86 REAL phi(ip1jmp1,llm) ! geopotentiel87 REAL w(ip1jmp1,llm) ! vitesse verticale88 93 89 94 c variables dynamiques intermediaire pour le transport … … 117 122 118 123 REAL SSUM 119 REAL time_0120 124 ! REAL finvmaold(ip1jmp1,llm) 121 125 … … 319 323 320 324 IF( forward. OR . leapf ) THEN 321 ! Ehouarn: NB: at this point p with ps are not synchronized 322 ! (whereas mass and ps are...) 325 ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step 323 326 CALL caladvtrac(q,pbaru,pbarv, 324 327 * p, masse, dq, teta, … … 441 444 $ ucov, vcov, teta , q ,ps , 442 445 $ dufi, dvfi, dtetafi , dqfi ,dpfi ) 446 ! since addfi updates ps(), also update p(), masse() and pk() 447 CALL pression (ip1jmp1,ap,bp,ps,p) 448 CALL massdair(p,masse) 449 if (pressure_exner) then 450 CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf) 451 else 452 CALL exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf) 453 endif 443 454 444 455 IF (ok_strato) THEN … … 499 510 CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf ) 500 511 endif 512 CALL massdair(p,masse) 501 513 502 514
Note: See TracChangeset
for help on using the changeset viewer.