Changeset 2160 for LMDZ5/branches/testing/libf/dyn3d_common
- Timestamp:
- Nov 28, 2014, 4:36:29 PM (11 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 1 deleted
- 8 edited
-
. (modified) (1 prop)
-
libf/dyn3d_common/caldyn0.F (modified) (2 diffs)
-
libf/dyn3d_common/control_mod.F90 (modified) (1 diff)
-
libf/dyn3d_common/disvert.F90 (modified) (1 diff)
-
libf/dyn3d_common/grid_atob.F (modified) (12 diffs)
-
libf/dyn3d_common/infotrac.F90 (modified) (3 diffs)
-
libf/dyn3d_common/interpre.F (modified) (1 diff)
-
libf/dyn3d_common/sortvarc.F (modified) (6 diffs)
-
libf/dyn3d_common/sortvarc0.F (deleted)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2072,2075-2115,2117-2126,2128-2158
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/dyn3d_common/caldyn0.F
r1999 r2160 6 6 $ phi,w,pbaru,pbarv,time ) 7 7 8 USE control_mod, ONLY: resetvarc 8 9 IMPLICIT NONE 9 10 … … 83 84 ENDDO 84 85 85 CALL sortvarc0 86 resetvarc=.true. ! force a recomputation of initial values in sortvarc 87 CALL sortvarc 86 88 $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov ) 87 89 -
LMDZ5/branches/testing/libf/dyn3d_common/control_mod.F90
r1999 r2160 10 10 IMPLICIT NONE 11 11 12 REAL :: periodav, starttime 13 INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys 14 INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy 15 INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn 16 LOGICAL :: offline 17 CHARACTER (len=4) :: config_inca 18 CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...) 19 LOGICAL output_grads_dyn ! output dynamics diagnostics in 20 ! binary grads file 'dyn.dat' (y/n) 21 LOGICAL ok_dynzon ! output zonal transports in dynzon.nc file 22 LOGICAL ok_dyn_ins ! output instantaneous values of fields 23 ! in the dynamics in NetCDF files dyn_hist*nc 24 LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics 25 ! in NetCDF files dyn_hist*ave.nc 12 REAL,SAVE :: periodav 13 REAL,SAVE :: starttime 14 INTEGER,SAVE :: nday ! # of days to run 15 INTEGER,SAVE :: day_step ! # of dynamical time steps per day 16 INTEGER,SAVE :: iperiod ! make a Matsuno step before avery iperiod-1 LF steps 17 INTEGER,SAVE :: iapp_tracvl ! apply (cumulated) traceur advection every 18 ! iapp_tracvl dynamical steps 19 INTEGER,SAVE :: nsplit_phys ! number of sub-cycle steps in call to physics 20 INTEGER,SAVE :: iconser 21 INTEGER,SAVE :: iecri 22 INTEGER,SAVE :: dissip_period ! apply dissipation every dissip_period 23 ! dynamical step 24 INTEGER,SAVE :: iphysiq ! call physics every iphysiq dynamical steps 25 INTEGER,SAVE :: iecrimoy 26 INTEGER,SAVE :: dayref 27 INTEGER,SAVE :: anneeref ! reference year # 28 INTEGER,SAVE :: raz_date 29 INTEGER,SAVE :: ip_ebil_dyn 30 LOGICAL,SAVE :: offline 31 CHARACTER(len=4),SAVE :: config_inca 32 CHARACTER(len=10),SAVE :: planet_type ! planet type ('earth','mars',...) 33 LOGICAL,SAVE :: output_grads_dyn ! output dynamics diagnostics in 34 ! binary grads file 'dyn.dat' (y/n) 35 LOGICAL,SAVE :: ok_dynzon ! output zonal transports in dynzon.nc file 36 LOGICAL,SAVE :: ok_dyn_ins ! output instantaneous values of fields 37 ! in the dynamics in NetCDF files dyn_hist*nc 38 LOGICAL,SAVE :: ok_dyn_ave ! output averaged values of fields in the dynamics 39 ! in NetCDF files dyn_hist*ave.nc 40 LOGICAL,SAVE :: resetvarc ! allows to reset the variables in sortvarc 26 41 27 42 END MODULE -
LMDZ5/branches/testing/libf/dyn3d_common/disvert.F90
r2056 r2160 25 25 !------------------------------------------------------------------------------- 26 26 ! Read in "comvert.h": 27 ! pa !--- PURE PRESSURE COORDINATE FOR P<pa (in Pascals) 27 28 ! pa !--- vertical coordinate is close to a PRESSURE COORDINATE FOR P 29 ! < 0.3 * pa (relative variation of p on a model level is < 0.1 %) 30 28 31 ! preff !--- REFERENCE PRESSURE (101325 Pa) 29 32 ! Written in "comvert.h": -
LMDZ5/branches/testing/libf/dyn3d_common/grid_atob.F
r1999 r2160 52 52 REAL zzmin 53 53 #endif 54 include "iniprint.h" 54 55 c 55 56 IF (imar.GT.2200 .OR. jmar.GT.1100) THEN … … 118 119 sortie(i,j) = sortie(i,j) / number(i,j) 119 120 ELSE 120 PRINT*, 'probleme,i,j=', i,j121 if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j 121 122 ccc CALL ABORT_GCM("", "", 1) 122 123 CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans) … … 135 136 j_proche = (ij_proche-1)/imdep + 1 136 137 i_proche = ij_proche - (j_proche-1)*imdep 137 PRINT*, "solution:", ij_proche, i_proche, j_proche 138 if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche, 139 $ j_proche 138 140 sortie(i,j) = entree(i_proche,j_proche) 139 141 ENDIF … … 449 451 REAL zzmin 450 452 #endif 453 include "iniprint.h" 451 454 c 452 455 IF (imar.GT.400 .OR. jmar.GT.400) THEN … … 512 515 sortie(i,j) = EXP(sortie(i,j)) 513 516 ELSE 514 PRINT*, 'probleme,i,j=', i,j517 if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j 515 518 ccc CALL ABORT_GCM("", "", 1) 516 519 CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans) … … 529 532 j_proche = (ij_proche-1)/imdep + 1 530 533 i_proche = ij_proche - (j_proche-1)*imdep 531 PRINT*, "solution:", ij_proche, i_proche, j_proche 534 if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche, 535 $ j_proche 532 536 sortie(i,j) = entree(i_proche,j_proche) 533 537 ENDIF … … 574 578 REAL zzmin 575 579 #endif 580 include "iniprint.h" 576 581 c 577 582 IF (imar.GT.400 .OR. jmar.GT.400) THEN … … 641 646 ENDIF 642 647 ELSE 643 PRINT*, 'probleme,i,j=', i,j648 if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j 644 649 ccc CALL ABORT_GCM("", "", 1) 645 650 CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans) … … 658 663 j_proche = (ij_proche-1)/imdep + 1 659 664 i_proche = ij_proche - (j_proche-1)*imdep 660 PRINT*, "solution:", ij_proche, i_proche, j_proche 665 if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche, 666 $ j_proche 661 667 IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN 662 668 frac_ice(i,j) = 1.0 … … 710 716 INTEGER i_proche, j_proche, ij_proche 711 717 c 718 include "iniprint.h" 719 712 720 IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN 713 721 PRINT*, 'immod ou jmmod trop grand', immod, jmmod … … 874 882 rugs(i,j) = EXP(rugs(i,j)) 875 883 ELSE 876 PRINT*, 'probleme,i,j=', i,j884 if (prt_level >= 1) PRINT*, 'probleme,i,j=', i,j 877 885 ccc CALL ABORT_GCM("", "", 1) 878 886 CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans) … … 891 899 j_proche = (ij_proche-1)/imtmp + 1 892 900 i_proche = ij_proche - (j_proche-1)*imtmp 893 PRINT*, "solution:", ij_proche, i_proche, j_proche 901 if (prt_level >= 1) PRINT*, "solution:", ij_proche, i_proche, 902 $ j_proche 894 903 rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche))) 895 904 ENDIF -
LMDZ5/branches/testing/libf/dyn3d_common/infotrac.F90
r1999 r2160 5 5 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 6 6 INTEGER, SAVE :: nqtot 7 !CR: on ajoute le nombre de traceurs de l eau 8 INTEGER, SAVE :: nqo 7 9 8 10 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid … … 228 230 endif ! of if (planet_type=="earth") 229 231 END IF 232 233 !CR: nombre de traceurs de l eau 234 if (tnom_0(3) == 'H2Oi') then 235 nqo=3 236 else 237 nqo=2 238 endif 230 239 231 240 WRITE(lunout,*) trim(modname),': Valeur de traceur.def :' … … 253 262 tnom_0(iq)=tracnam(iq-2) 254 263 END DO 264 nqo = 2 255 265 256 266 END IF ! type_trac -
LMDZ5/branches/testing/libf/dyn3d_common/interpre.F
r1999 r2160 29 29 real masse(iip1,jjp1,llm) 30 30 real massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm) 31 real w(iip1,jjp1,llm +1)31 real w(iip1,jjp1,llm) 32 32 real fluxwppm(iim,jjp1,llm) 33 33 real pbaru(iip1,jjp1,llm ) -
LMDZ5/branches/testing/libf/dyn3d_common/sortvarc.F
r1999 r2160 5 5 $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time , 6 6 $ vcov ) 7 8 USE control_mod, ONLY: resetvarc 7 9 IMPLICIT NONE 10 8 11 9 12 c======================================================================= … … 22 25 c ------------- 23 26 24 #include "dimensions.h" 25 #include "paramet.h" 26 #include "comconst.h" 27 #include "comvert.h" 28 #include "comgeom.h" 29 #include "ener.h" 30 #include "logic.h" 31 #include "temps.h" 27 INCLUDE "dimensions.h" 28 INCLUDE "paramet.h" 29 INCLUDE "comconst.h" 30 INCLUDE "comvert.h" 31 INCLUDE "comgeom.h" 32 INCLUDE "ener.h" 33 INCLUDE "logic.h" 34 INCLUDE "temps.h" 35 INCLUDE "iniprint.h" 32 36 33 37 c Arguments: 34 38 c ---------- 35 39 36 INTEGER itau 37 REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm) 38 REAL vcov(ip1jm,llm) 39 REAL ps(ip1jmp1),phis(ip1jmp1) 40 REAL vorpot(ip1jm,llm) 41 REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm) 42 REAL dp(ip1jmp1) 43 REAL time 44 REAL pk(ip1jmp1,llm) 40 INTEGER,INTENT(IN) :: itau 41 REAL,INTENT(IN) :: ucov(ip1jmp1,llm) 42 REAL,INTENT(IN) :: teta(ip1jmp1,llm) 43 REAL,INTENT(IN) :: masse(ip1jmp1,llm) 44 REAL,INTENT(IN) :: vcov(ip1jm,llm) 45 REAL,INTENT(IN) :: ps(ip1jmp1) 46 REAL,INTENT(IN) :: phis(ip1jmp1) 47 REAL,INTENT(IN) :: vorpot(ip1jm,llm) 48 REAL,INTENT(IN) :: phi(ip1jmp1,llm) 49 REAL,INTENT(IN) :: bern(ip1jmp1,llm) 50 REAL,INTENT(IN) :: dp(ip1jmp1) 51 REAL,INTENT(IN) :: time 52 REAL,INTENT(IN) :: pk(ip1jmp1,llm) 45 53 46 54 c Local: … … 51 59 REAL cosphi(ip1jm),omegcosp(ip1jm) 52 60 REAL dtvrs1j,rjour,heure,radsg,radomeg 53 REAL rday,massebxy(ip1jm,llm)61 REAL massebxy(ip1jm,llm) 54 62 INTEGER l, ij, imjmp1 55 63 56 64 REAL SSUM 65 LOGICAL,SAVE :: firstcal=.true. 66 CHARACTER(LEN=*),PARAMETER :: modname="sortvarc" 57 67 58 68 c----------------------------------------------------------------------- 69 ! Ehouarn: when no initialization fields from file, resetvarc should be 70 ! set to false 71 if (firstcal) then 72 if (.not.read_start) then 73 resetvarc=.true. 74 endif 75 endif 59 76 60 77 dtvrs1j = dtvr/daysec … … 115 132 * cosphi(ij) 116 133 ENDDO 117 angl(l) = rad sg*134 angl(l) = rad * 118 135 s (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1)) 119 136 ENDDO … … 129 146 ang = SSUM( llm, angl, 1 ) 130 147 131 c rday = REAL(INT ( day_ini + time )) 132 c 133 rday = REAL(INT(time-jD_ref-jH_ref)) 134 IF(ptot0.eq.0.) THEN 135 PRINT 3500, itau, rday, heure,time 136 PRINT*,'WARNING!!! On recalcule les valeurs initiales de :' 137 PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang' 138 PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang 148 IF (firstcal.and.resetvarc) then 149 WRITE(lunout,3500) itau, rjour, heure, time 150 WRITE(lunout,*) trim(modname), 151 & ' WARNING!!! Recomputing initial values of : ' 152 WRITE(lunout,*) 'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang' 153 WRITE(lunout,*) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang 139 154 etot0 = etot 140 155 ptot0 = ptot … … 144 159 END IF 145 160 146 etot= etot/etot0 161 ! compute relative changes in etot,... (except if 'reference' values 162 ! are zero, which can happen when using iniacademic) 163 if (etot0.ne.0) then 164 etot= etot/etot0 165 else 166 etot=1. 167 endif 147 168 rmsv= SQRT(rmsv/ptot) 148 ptot= ptot/ptot0 149 ztot= ztot/ztot0 150 stot= stot/stot0 151 ang = ang /ang0 152 153 154 PRINT 3500, itau, rday, heure, time 155 PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang 156 157 RETURN 169 if (ptot0.ne.0) then 170 ptot= ptot/ptot0 171 else 172 ptot=1. 173 endif 174 if (ztot0.ne.0) then 175 ztot= ztot/ztot0 176 else 177 ztot=1. 178 endif 179 if (stot0.ne.0) then 180 stot= stot/stot0 181 else 182 stot=1. 183 endif 184 if (ang0.ne.0) then 185 ang = ang /ang0 186 else 187 ang=1. 188 endif 189 190 firstcal = .false. 191 192 WRITE(lunout,3500) itau, rjour, heure, time 193 WRITE(lunout,4000) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang 158 194 159 195 3500 FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x
Note: See TracChangeset
for help on using the changeset viewer.
