Changeset 3509 for trunk/LMDZ.MARS/libf/phymars/iostart.F90

Timestamp:

Nov 8, 2024, 4:59:55 PM (2 weeks ago)

Author:

jbclement

Message:

Dynamic + Mars PCM:
Addition of the description for the 'controle' array in the "start.nc" and "startfi.nc" files. It is given by the variable 'controle_descriptor' whose the element 'controle_descriptor(i)' explains 'controle(i)'.
JBC

File:

• trunk/LMDZ.MARS/libf/phymars/iostart.F90 (modified) (9 diffs)

trunk/LMDZ.MARS/libf/phymars/iostart.F90

@@ -8 +8 @@
     
     ! restartfi.nc file dimension identifiers: (see open_restartphy())
-    INTEGER,SAVE :: idim1 ! "index" dimension
-    INTEGER,SAVE :: idim2 ! "physical_points" dimension
-    INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
-    INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
-    INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
-    INTEGER,SAVE :: idim6 ! "nlayer" dimension
-    INTEGER,SAVE :: idim7 ! "Time" dimension
-    INTEGER,SAVE :: idim8 ! "nslope" dimension
-    INTEGER,SAVE :: idim9 ! "nslope_plus_1" dimension
+    INTEGER,SAVE :: idim1  ! "index" dimension
+    INTEGER,SAVE :: idim2  ! "physical_points" dimension
+    INTEGER,SAVE :: idim3  ! "subsurface_layers" dimension
+    INTEGER,SAVE :: idim4  ! "nlayer_plus_1" dimension
+    INTEGER,SAVE :: idim5  ! "number_of_advected_fields" dimension
+    INTEGER,SAVE :: idim6  ! "nlayer" dimension
+    INTEGER,SAVE :: idim7  ! "Time" dimension
+    INTEGER,SAVE :: idim8  ! "nslope" dimension
+    INTEGER,SAVE :: idim9  ! "nslope_plus_1" dimension
+    INTEGER,SAVE :: idim10 ! "descriptor" dimension
+    INTEGER,SAVE :: idim11 ! "description_size" dimension
     INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
-    INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
-    
+    INTEGER,PARAMETER :: length = 100 ! size of tab_cntrl array
+    INTEGER,PARAMETER :: ldscrpt = 35 ! size of dscrpt_tab_cntrl array
+    INTEGER,PARAMETER :: ndscrpt = 50 ! size of characters in dscrpt_tab_cntrl array
+
     INTERFACE get_field
       MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
     END INTERFACE get_field
-    
+
     INTERFACE get_var
       MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
@@ -33 +37 @@
 
     INTERFACE put_var
-      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
+      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3, put_var_c1
     END INTERFACE put_var
 
-    PUBLIC nid_start, length
+    PUBLIC nid_start, length, ldscrpt, ndscrpt
     PUBLIC get_field,get_var,put_field,put_var
     PUBLIC inquire_dimension, inquire_dimension_length
     PUBLIC inquire_field, inquire_field_ndims
     PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
-    
+
 CONTAINS
 
@@ -178 +182 @@
 
   END FUNCTION inquire_dimension_length
-
-
 
   SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
@@ -566 +568 @@
       ierr=NF90_DEF_DIM(nid_restart,"nslope",nslope,idim8)
       IF (ierr/=NF90_NOERR) THEN
-        write(*,*)'phyredem: problem defining nslope dimension'
-        write(*,*)trim(nf90_strerror(ierr))
-        CALL ABORT
+        write(*,*)'open_restartphy: problem defining nslope dimension'
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL abort_physic("open_restartphy","Failed defining nslope",1)
       ENDIF
 
       ierr=NF90_DEF_DIM(nid_restart,"inter_slope",nslope+1,idim9)
       IF (ierr/=NF90_NOERR) THEN
-        write(*,*)'phyredem: problem defining inter slope dimension'
-        write(*,*)trim(nf90_strerror(ierr))
-        CALL ABORT
+        write(*,*)'open_restartphy: problem defining inter_slope dimension'
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL abort_physic("open_restartphy","Failed defining inter_slope",1)
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"descriptor",ldscrpt,idim10)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining descriptor dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL abort_physic("open_restartphy","Failed defining descriptor",1)
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"description_size",ndscrpt,idim11)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining description_size dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL abort_physic("open_restartphy","Failed defining description_size",1)
       ENDIF
 
@@ -946 +962 @@
   END SUBROUTINE put_var_r0
 
-
   SUBROUTINE put_var_r1(var_name,title,var)
   ! Put a vector in file
@@ -967 +982 @@
      CALL put_var_rgen(var_name,title,var,size(var))
 
-  END SUBROUTINE put_var_r2     
+  END SUBROUTINE put_var_r2
   
   SUBROUTINE put_var_r3(var_name,title,var)
@@ -1029 +1044 @@
           write(*,*)'put_var_rgen: problem writing Time'
           write(*,*)trim(nf90_strerror(ierr))
-          CALL abort_physic("get_var_rgen","Failed to write Time",1)
+          CALL abort_physic("put_var_rgen","Failed to write Time",1)
         ENDIF
         return ! nothing left to do
@@ -1036 +1051 @@
         idim1d=idim1
       ELSEIF (var_size==nsoilmx) THEN
-        ! We know it is an  "mlayer" kind of 1D array
+        ! We know it is an "mlayer" kind of 1D array
         idim1d=idim3
       ELSEIF (var_size==nslope+1) THEN
-        ! We know it is an  "inter slope" kind of 1D array
+        ! We know it is an "inter slope" kind of 1D array
         idim1d=idim9
       ELSE 
         PRINT *, "put_var_rgen error : wrong dimension"
         write(*,*) "  var_size =",var_size
-        CALL abort_physic("get_var_rgen","Wrong variable dimension",1)
+        CALL abort_physic("put_var_rgen","Wrong variable dimension",1)
 
       ENDIF ! of IF (var_size==length) THEN
@@ -1070 +1085 @@
     ENDIF ! of IF (is_master)
     
-  END SUBROUTINE put_var_rgen     
+  END SUBROUTINE put_var_rgen
+
+  SUBROUTINE put_var_c1(var_name,title,var)
+  ! Put a vector of characters in file
+
+  USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
+                    NF90_CHAR, &
+                    NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
+                    nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
+  USE comsoil_h, only: nsoilmx
+  USE comslope_mod, only: nslope
+  USE mod_phys_lmdz_para, only: is_master
+
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     CHARACTER(LEN=*),INTENT(IN) :: var(:)
+
+     INTEGER :: ierr
+     INTEGER :: nvarid
+     INTEGER :: idim1d_1, idim1d_2
+     INTEGER :: var_size
+     logical,save :: firsttime=.true.
+
+    IF (is_master) THEN
+
+      var_size = size(var)
+      IF (var_size==ldscrpt) THEN
+        ! We know it is a "controle descriptor" kind of 1D array
+        idim1d_1=idim11
+        idim1d_2=idim10
+      ELSE 
+        PRINT *, "put_var_cgen error : wrong dimension"
+        write(*,*) "  var_size =",var_size
+        CALL abort_physic("put_var_cgen","Wrong variable dimension",1)
+
+      ENDIF ! of IF (var_size==length) THEN
+
+      ! Swich to NetCDF define mode
+      ierr=NF90_REDEF (nid_restart)
+      ! Define the variable
+      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_CHAR,(/idim1d_1,idim1d_2/),nvarid)
+      ! Add a "title" attribute
+      IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+      ! Swich out of define mode
+      ierr=NF90_ENDDEF(nid_restart)
+      ! Write variable to file
+      ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'put_var_cgen: problem writing '//trim(var_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL abort_physic("put_var_cgen","Failed writing variable",1)
+      ENDIF
+    ENDIF ! of IF (is_master)
+
+  END SUBROUTINE put_var_c1
 
 END MODULE iostart