Changeset 2083 for LMDZ5/trunk/libf/dyn3d_common

Timestamp:

Jul 9, 2014, 4:43:31 PM (10 years ago)

Author:

Ehouarn Millour

Message:

• Minor fix in dyn3dpar/leapfrog_p.F , should call geopot_p and not geopot
• Added a sanity check in iniacademic
• Added flag "resetvarc" to trigger a reset of initial values in sortvarc
• Removed "sortvarc0" since the job can now be done with "resetvarc" and having set flag resertvarc to true.

EM

Location:

LMDZ5/trunk/libf/dyn3d_common

Files:

• caldyn0.F (modified) (2 diffs)
• control_mod.F90 (modified) (1 diff)
• sortvarc.F (modified) (6 diffs)
• sortvarc0.F (deleted)

LMDZ5/trunk/libf/dyn3d_common/caldyn0.F

@@ -6 +6 @@
      $  phi,w,pbaru,pbarv,time )
 
+      USE control_mod, ONLY: resetvarc 
       IMPLICIT NONE
 
@@ -83 +84 @@
       ENDDO
 
-        CALL sortvarc0
+      resetvarc=.true. ! force a recomputation of initial values in sortvarc
+      CALL sortvarc
      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
 

LMDZ5/trunk/libf/dyn3d_common/control_mod.F90

@@ -10 +10 @@
   IMPLICIT NONE
 
-  REAL    :: periodav, starttime
-  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
-  INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy
-  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
-  LOGICAL :: offline
-  CHARACTER (len=4)  :: config_inca
-  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
-  LOGICAL output_grads_dyn ! output dynamics diagnostics in
-                           ! binary grads file 'dyn.dat' (y/n)
-  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
-  LOGICAL ok_dyn_ins ! output instantaneous values of fields
-                     ! in the dynamics in NetCDF files dyn_hist*nc
-  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
-                     ! in NetCDF files dyn_hist*ave.nc
+  REAL,SAVE :: periodav
+  REAL,SAVE :: starttime
+  INTEGER,SAVE :: nday ! # of days to run
+  INTEGER,SAVE :: day_step ! # of dynamical time steps per day
+  INTEGER,SAVE :: iperiod ! make a Matsuno step before avery iperiod-1 LF steps
+  INTEGER,SAVE :: iapp_tracvl ! apply (cumulated) traceur advection every
+                              ! iapp_tracvl dynamical steps
+  INTEGER,SAVE :: nsplit_phys ! number of sub-cycle steps in call to physics
+  INTEGER,SAVE :: iconser
+  INTEGER,SAVE :: iecri
+  INTEGER,SAVE :: dissip_period ! apply dissipation every dissip_period
+                                ! dynamical step
+  INTEGER,SAVE :: iphysiq ! call physics every iphysiq dynamical steps
+  INTEGER,SAVE :: iecrimoy
+  INTEGER,SAVE :: dayref
+  INTEGER,SAVE :: anneeref ! reference year #
+  INTEGER,SAVE :: raz_date
+  INTEGER,SAVE :: ip_ebil_dyn
+  LOGICAL,SAVE :: offline
+  CHARACTER(len=4),SAVE :: config_inca
+  CHARACTER(len=10),SAVE :: planet_type ! planet type ('earth','mars',...)
+  LOGICAL,SAVE :: output_grads_dyn ! output dynamics diagnostics in
+                                   ! binary grads file 'dyn.dat' (y/n)
+  LOGICAL,SAVE :: ok_dynzon  ! output zonal transports in dynzon.nc file
+  LOGICAL,SAVE ::  ok_dyn_ins ! output instantaneous values of fields
+                              ! in the dynamics in NetCDF files dyn_hist*nc
+  LOGICAL,SAVE :: ok_dyn_ave ! output averaged values of fields in the dynamics
+                             ! in NetCDF files dyn_hist*ave.nc
+  LOGICAL,SAVE :: resetvarc  ! allows to reset the variables in sortvarc
 
 END MODULE

LMDZ5/trunk/libf/dyn3d_common/sortvarc.F

@@ -5 +5 @@
      $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
      $ vcov )
+
+      USE control_mod, ONLY: resetvarc 
       IMPLICIT NONE
+
 
 c=======================================================================
@@ -22 +25 @@
 c   -------------
 
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "ener.h"
-#include "logic.h"
-#include "temps.h"
+      INCLUDE "dimensions.h"
+      INCLUDE "paramet.h"
+      INCLUDE "comconst.h"
+      INCLUDE "comvert.h"
+      INCLUDE "comgeom.h"
+      INCLUDE "ener.h"
+      INCLUDE "logic.h"
+      INCLUDE "temps.h"
+      INCLUDE "iniprint.h"
 
 c   Arguments:
 c   ----------
 
-      INTEGER itau
-      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
-      REAL vcov(ip1jm,llm)
-      REAL ps(ip1jmp1),phis(ip1jmp1)
-      REAL vorpot(ip1jm,llm)
-      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
-      REAL dp(ip1jmp1)
-      REAL time
-      REAL pk(ip1jmp1,llm)
+      INTEGER,INTENT(IN) :: itau
+      REAL,INTENT(IN) :: ucov(ip1jmp1,llm)
+      REAL,INTENT(IN) :: teta(ip1jmp1,llm)
+      REAL,INTENT(IN) :: masse(ip1jmp1,llm)
+      REAL,INTENT(IN) :: vcov(ip1jm,llm)
+      REAL,INTENT(IN) :: ps(ip1jmp1)
+      REAL,INTENT(IN) :: phis(ip1jmp1)
+      REAL,INTENT(IN) :: vorpot(ip1jm,llm)
+      REAL,INTENT(IN) :: phi(ip1jmp1,llm)
+      REAL,INTENT(IN) :: bern(ip1jmp1,llm)
+      REAL,INTENT(IN) :: dp(ip1jmp1)
+      REAL,INTENT(IN) :: time
+      REAL,INTENT(IN) :: pk(ip1jmp1,llm)
 
 c   Local:
@@ -51 +59 @@
       REAL cosphi(ip1jm),omegcosp(ip1jm)
       REAL dtvrs1j,rjour,heure,radsg,radomeg
-      REAL rday, massebxy(ip1jm,llm)
+      REAL massebxy(ip1jm,llm)
       INTEGER  l, ij, imjmp1
 
       REAL       SSUM
+      LOGICAL,SAVE :: firstcal=.true.
+      CHARACTER(LEN=*),PARAMETER :: modname="sortvarc"
 
 c-----------------------------------------------------------------------
+! Ehouarn: when no initialization fields from file, resetvarc should be
+!          set to false
+       if (firstcal) then
+         if (.not.read_start) then
+           resetvarc=.true.
+         endif
+       endif
 
        dtvrs1j   = dtvr/daysec
@@ -115 +132 @@
      *               cosphi(ij)
           ENDDO
-          angl(l) = radsg *
+          angl(l) = rad *
      s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
       ENDDO
@@ -129 +146 @@
       ang   = SSUM(     llm,  angl, 1 )
 
-c      rday = REAL(INT ( day_ini + time ))
-c
-       rday = REAL(INT(time-jD_ref-jH_ref))
-      IF(ptot0.eq.0.)  THEN
-         PRINT 3500, itau, rday, heure,time
-         PRINT*,'WARNING!!! On recalcule les valeurs initiales de :'
-         PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
-         PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+      IF (firstcal.and.resetvarc) then
+         WRITE(lunout,3500) itau, rjour, heure, time
+         WRITE(lunout,*) trim(modname),
+     &     ' WARNING!!! Recomputing initial values of : '
+         WRITE(lunout,*) 'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
+         WRITE(lunout,*) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
          etot0 = etot
          ptot0 = ptot
@@ -144 +159 @@
       END IF
 
-      etot= etot/etot0
+      ! compute relative changes in etot,... (except if 'reference' values
+      ! are zero, which can happen when using iniacademic)
+      if (etot0.ne.0) then
+        etot= etot/etot0
+      else
+        etot=1.
+      endif
       rmsv= SQRT(rmsv/ptot)
-      ptot= ptot/ptot0
-      ztot= ztot/ztot0
-      stot= stot/stot0
-      ang = ang /ang0
-
-
-      PRINT 3500, itau, rday, heure, time
-      PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
-
-      RETURN
+      if (ptot0.ne.0) then
+        ptot= ptot/ptot0
+      else
+        ptot=1.
+      endif
+      if (ztot0.ne.0) then
+        ztot= ztot/ztot0
+      else
+        ztot=1.
+      endif
+      if (stot0.ne.0) then
+        stot= stot/stot0
+      else
+        stot=1.
+      endif
+      if (ang0.ne.0) then
+        ang = ang /ang0
+      else
+        ang=1.
+      endif
+
+      firstcal = .false.
+
+      WRITE(lunout,3500) itau, rjour, heure, time
+      WRITE(lunout,4000) ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
 
 3500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x