Changeset 999 for trunk/LMDZ.MARS/libf/dyn3d/dynredem.F

Timestamp:

Jul 2, 2013, 9:40:28 AM (11 years ago)

Author:

tnavarro

Message:

Possibility to store multiple initial states in one start/startfi. This is RETROCOMPATIBLE. New option ecrithist in run.def to write data in start/startfi every ecrithist dynamical timestep. New option timestart in run.def to initialize the GCM with the time timestart stored in start

File:

• trunk/LMDZ.MARS/libf/dyn3d/dynredem.F (modified) (13 diffs)

trunk/LMDZ.MARS/libf/dyn3d/dynredem.F

@@ -36 +36 @@
       character*80 abort_message
       character(len=80) :: txt ! to store some text
+      
+      !REAL  hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0=<hour_ini<1
+
 
 c   Variables locales pour NetCDF:
@@ -72 +75 @@
        tab_cntrl(7)  = g
        tab_cntrl(8)  = cpp
-       tab_cntrl(9) = kappa
+       tab_cntrl(9)  = kappa
        tab_cntrl(10) = daysec
        tab_cntrl(11) = dtvr
@@ -82 +85 @@
        tab_cntrl(17) = pa
        tab_cntrl(18) = preff
+       
+       tab_cntrl(29) = hour_ini
+
 c
 c    .....    parametres  pour le zoom      ......   
@@ -106 +112 @@
        IF( ysinus )  tab_cntrl(26) = 1. 
       ENDIF
+      
+
 c
 c    .........................................................
@@ -983 +991 @@
       character*80 abort_message
 c
+
+      INTEGER edges(4),corner(4)
+
       INTEGER nb,i,j
-      SAVE nb
-      DATA nb / 0 /
+      
 
       modname = 'dynredem1'
@@ -993 +1003 @@
          CALL abort
       ENDIF
+      
+c On a single run, different files can be written with dynredem1.
+c Therefore, get the last time index from the file itself:
+      ierr = NF_INQ_DIMID(nid,"Time",nvarid)
+      ierr = NF_INQ_DIMLEN(nid,nvarid,nb)
 
 c  Ecriture/extension de la coordonnee temps
@@ -1008 +1023 @@
       ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
 #endif
-      PRINT*, "Enregistrement pour ", nb, time
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture temps!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
+      !PRINT*, "Enregistrement pour ", nb, time
 
 c  Ecriture des champs
 c
+      corner(1)=1
+      corner(2)=1
+      corner(3)=1
+      corner(4)=nb
+      edges(1)=iip1
+      edges(2)=jjm
+      edges(3)=llm
+      edges(4)=1
+      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable vcov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,vcov)
+#else
+      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,vcov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture vcov!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
+      
+c Following corner and egdes are the same for ucov, teta, tracers and masse:
+      corner(1)=1
+      corner(2)=1
+      corner(3)=1
+      corner(4)=nb
+      edges(1)=iip1
+      edges(2)=jjp1
+      edges(3)=llm
+      edges(4)=1
       ierr = NF_INQ_VARID(nid, "ucov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
@@ -1018 +1069 @@
       ENDIF
 #ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
-#endif
-
-      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
-#endif
+      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,ucov)
+#else
+      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,ucov)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture ucov!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
+      
 
       ierr = NF_INQ_VARID(nid, "teta", nvarid)
@@ -1040 +1085 @@
       ENDIF
 #ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
-#endif
+      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,teta)
+#else
+      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,teta)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture teta!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
 
       IF (nq.GT.99) THEN
@@ -1068 +1117 @@
             enddo
 #ifdef NC_DOUBLE
-            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q3d)
-#else
-            ierr = NF_PUT_VAR_REAL (nid,nvarid,q3d)
+            ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edgesq3d)
+#else
+            ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,q3d)
 #endif
             IF (ierr .NE. NF_NOERR) THEN
@@ -1079 +1128 @@
       ENDIF
 c
+
       ierr = NF_INQ_VARID(nid, "masse", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
@@ -1085 +1135 @@
       ENDIF
 #ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
-#endif
-c
+      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,masse)
+#else
+      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,masse)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture masse!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
+c
+
+      corner(1)=1
+      corner(2)=1
+      corner(3)=nb
+      edges(1)=iip1
+      edges(2)=jjp1
+      edges(3)=1
       ierr = NF_INQ_VARID(nid, "ps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
@@ -1096 +1157 @@
       ENDIF
 #ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
-#endif
+      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,ps)
+#else
+      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,ps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         print*, "Erreur ecriture ps!!"
+         print*, NF_STRERROR(ierr)
+      ENDIF
 
       ierr = NF_CLOSE(nid)