Changeset 358 for IOIPSL/trunk

Timestamp:

07/17/08 12:27:56 (16 years ago)

Author:

bellier

Message:

A little step towards the CF Metadata Convention

File:

• IOIPSL/trunk/src/histcom.f90 (modified) (54 diffs)

IOIPSL/trunk/src/histcom.f90

@@ -61 +61 @@
 !-
   INTERFACE histbeg
-!!  MODULE PROCEDURE histbeg_regular,histbeg_irregular
     MODULE PROCEDURE histbeg_totreg,histbeg_regular,histbeg_irregular
   END INTERFACE
@@ -85 +84 @@
 !-
   INTEGER,SAVE :: nb_files=0
-  INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0, nb_tax=0
+  INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0,nb_tax=0
 !-
 ! DOMAIN IDs for files
@@ -316 +315 @@
   INTEGER,INTENT(IN) :: pim,pjm
   REAL,DIMENSION(pim,pjm),INTENT(IN) :: plon,plat
-  INTEGER,INTENT(IN):: par_orix, par_szx, par_oriy, par_szy
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
   INTEGER,INTENT(IN) :: pitau0
-  REAL,INTENT(IN) :: pdate0, pdeltat
-  INTEGER,INTENT(OUT) :: pfileid, phoriid
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: pfileid,phoriid
   LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear
   INTEGER,INTENT(IN),OPTIONAL :: domain_id
 !-
-  INTEGER :: ncid, iret
+  INTEGER :: ncid,iret
   CHARACTER(LEN=120) :: file
   CHARACTER(LEN=30) :: timenow
@@ -354 +353 @@
     CALL ipslerr (3,"histbeg", &
    &  'Table of files too small. You should increase nb_files_max', &
-   &  'in M_HISTCOM.f90 in order to accomodate all these files', ' ')
+   &  'in histcom.f90 in order to accomodate all these files', ' ')
   ENDIF
 !-
@@ -371 +370 @@
 ! Add DOMAIN number and ".nc" suffix in file name if needed
 !-
-  file  = pfilename
+  file = pfilename
   CALL flio_dom_file (file,domain_id)
 !-
-  iret = NF90_CREATE (file, NF90_CLOBBER, ncid)
+  iret = NF90_CREATE (file,NF90_CLOBBER,ncid)
 !-
   IF (rectilinear) THEN
@@ -390 +389 @@
 ! 4.3 Global attributes
 !-
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.3')
   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
@@ -409 +408 @@
 ! 6.0 storing the geographical coordinates
 !-
-  IF ( (pim /= par_szx).OR.(pjm /= par_szy) )   zoom(pfileid)=.TRUE.
+  zoom(pfileid) = (pim /= par_szx).OR.(pjm /= par_szy)
   regular(pfileid)=.TRUE.
 !-
@@ -468 +467 @@
   REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
   INTEGER,INTENT(IN) :: pitau0
-  REAL,INTENT(IN) :: pdate0, pdeltat
-  INTEGER,INTENT(OUT) :: pfileid, phoriid
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: pfileid,phoriid
   INTEGER,INTENT(IN),OPTIONAL :: domain_id
 !-
-  INTEGER :: ncid, iret
+  INTEGER :: ncid,iret
   CHARACTER(LEN=120) :: file
   CHARACTER(LEN=30) :: timenow
@@ -496 +495 @@
     CALL ipslerr (3,"histbeg", &
    &  'Table of files too small. You should increase nb_files_max', &
-   &  'in M_HISTCOM.f90 in order to accomodate all these files', ' ')
+   &  'in histcom.f90 in order to accomodate all these files',' ')
   ENDIF
 !-
@@ -527 +526 @@
 ! 4.3 Global attributes
 !-
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.3')
   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
   iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
@@ -596 +595 @@
   CHARACTER(LEN=80) :: tmp_title, tmp_name
   INTEGER :: ndim
-  INTEGER,DIMENSION(2) :: dims(2)
+  INTEGER,DIMENSION(2) :: dims
   INTEGER :: nlonid, nlatid
   INTEGER :: orix, oriy, par_szx, par_szy
@@ -715 +714 @@
 ! Transfer the latitude
 !-
-  IF ( rectilinear ) THEN
+  IF (rectilinear) THEN
     iret = NF90_PUT_VAR (ncid,nlatid,plat(1,oriy:oriy+par_szy-1))
   ELSE
@@ -791 +790 @@
   ncid = ncdf_ids(pfileid)
 !-
-  IF     ( SIZE(plon_bounds,DIM=1) == pim ) THEN
+  IF     (SIZE(plon_bounds,DIM=1) == pim) THEN
     nbbounds = SIZE(plon_bounds,DIM=2)
     transp = .TRUE.
-  ELSEIF ( SIZE(plon_bounds,DIM=2) == pim ) THEN
+  ELSEIF (SIZE(plon_bounds,DIM=2) == pim) THEN
     nbbounds = SIZE(plon_bounds,DIM=1)
     transp = .FALSE.
@@ -913 +912 @@
 END SUBROUTINE histhori_irregular
 !===
-SUBROUTINE histvert (pfileid, pzaxname, pzaxtitle, &
- &                   pzaxunit, pzsize, pzvalues, pzaxid, pdirect)
+SUBROUTINE histvert (pfileid,pzaxname,pzaxtitle,pzaxunit, &
+ &                   pzsize,pzvalues,pzaxid,pdirect)
 !---------------------------------------------------------------------
 !- This subroutine defines a vertical axis and returns it s id.
@@ -926 +925 @@
 !- pzaxname : Name of the vertical axis
 !- pzaxtitle: title of the vertical axis
-!- pzaxunit : Units of the vertical axis
+!- pzaxunit : Units of the vertical axis (no units ih blank string)
 !- pzsize   : size of the vertical axis
 !- pzvalues : Coordinate values of the vetical axis
@@ -948 +947 @@
   CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect
 !-
-  INTEGER :: pos, iv, nb, zdimid, zaxid_tmp
-  CHARACTER(LEN=20) :: str20
-  CHARACTER(LEN=70) :: str70, str71, str72
+  INTEGER :: pos,iv,zdimid,zaxid_tmp
+  CHARACTER(LEN=70) :: str71
   CHARACTER(LEN=80) :: str80
   CHARACTER(LEN=20) :: direction
@@ -986 +984 @@
   ENDIF
 !-
-  IF ( nb_zax(pfileid)+1 > nb_zax_max) THEN
+  IF (nb_zax(pfileid)+1 > nb_zax_max) THEN
     CALL ipslerr (3,"histvert", &
    &  'Table of vertical axes too small. You should increase ',&
-   &  'nb_zax_max in M_HISTCOM.f90 in order to accomodate all ', &
+   &  'nb_zax_max in histcom.f90 in order to accomodate all ', &
    &  'these variables ')
   ENDIF
 !-
   iv = nb_zax(pfileid)
-  IF ( iv > 1) THEN
-    str20 = pzaxname
-    nb = iv-1
-    CALL find_str (zax_name(pfileid,1:nb),str20,pos)
+  IF (iv > 1) THEN
+    CALL find_str (zax_name(pfileid,1:iv-1),pzaxname,pos)
   ELSE
     pos = 0
   ENDIF
 !-
-  IF ( pos > 0) THEN
-    str70 = "Vertical axis already exists"
-    WRITE(str71,'("Check variable ",A," in file",I3)') str20,pfileid
-    str72 = "Can also be a wrong file ID in another declaration"
-    CALL ipslerr (3,"histvert", str70, str71, str72)
+  IF (pos > 0) THEN
+    WRITE(str71,'("Check variable ",A," in file",I3)') &
+ &    TRIM(pzaxname),pfileid
+    CALL ipslerr (3,"histvert", &
+ &    "Vertical axis already exists",TRIM(str71), &
+ &    "Can also be a wrong file ID in another declaration")
   ENDIF
 !-
@@ -1022 +1019 @@
   iret = NF90_DEF_VAR (ncid,pzaxname(1:leng),NF90_FLOAT, &
  &                     zaxid_tmp,zdimid)
-!-
   iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z")
   leng = MIN(LEN_TRIM(pzaxunit),20)
-  iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng))
+  IF (leng > 0) THEN
+    iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
   iret = NF90_PUT_ATT (ncid,zdimid,'positive',TRIM(direction))
   iret = NF90_PUT_ATT (ncid,zdimid,'valid_min', &
@@ -1044 +1042 @@
 !- 3.0 add the information to the common
 !-
-  IF ( check) &
+  IF (check) &
   &  WRITE(*,*) "histvert : 3.0 add the information to the common"
 !-
@@ -1072 +1070 @@
 !- pvarname : Name of the variable, short and easy to remember
 !- ptitle   : Full name of the variable
-!- punit    : Units of the variable
+!- punit    : Units of the variable (no units if blank string)
 !-
 !- The next 3 arguments give the size of that data
@@ -1116 +1114 @@
   REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
 !-
-  INTEGER :: iv, i, nb
+  INTEGER :: iv,i
   CHARACTER(LEN=70) :: str70, str71, str72
   CHARACTER(LEN=20) :: tmp_name
-  CHARACTER(LEN=20) :: str20
-  CHARACTER(LEN=40) :: str40, tab_str40(nb_var_max)
+  CHARACTER(LEN=40) :: str40
   CHARACTER(LEN=10) :: str10
   CHARACTER(LEN=80) :: tmp_str80
@@ -1135 +1132 @@
   iv = nb_var(pfileid)
 !-
-  IF ( iv > nb_var_max) THEN
+  IF (iv > nb_var_max) THEN
     CALL ipslerr (3,"histdef", &
    &  'Table of variables too small. You should increase nb_var_max',&
-   &  'in M_HISTCOM.f90 in order to accomodate all these variables', &
+   &  'in histcom.f90 in order to accomodate all these variables', &
    &  ' ')
   ENDIF
@@ -1148 +1145 @@
 !-
   IF (iv > 1) THEN
-    str20 = pvarname
-    nb = iv-1
-    CALL find_str (name(pfileid,1:nb),str20,pos)
+    CALL find_str (name(pfileid,1:iv-1),pvarname,pos)
   ELSE
     pos = 0
@@ -1157 +1152 @@
   IF (pos > 0) THEN
     str70 = "Variable already exists"
-    WRITE(str71,'("Check variable  ",a," in file",I3)') str20,pfileid
+    WRITE(str71,'("Check variable  ",a," in file",I3)') &
+ &    TRIM(pvarname),pfileid
     str72 = "Can also be a wrong file ID in another declaration"
     CALL ipslerr (3,"histdef", str70, str71, str72)
@@ -1235 +1231 @@
 !     and a fall back onto the default grid
 !-
-  IF ( phoriid > 0 .AND. phoriid <= nb_hax(pfileid)) THEN
+  IF ( (phoriid > 0).AND.(phoriid <= nb_hax(pfileid)) ) THEN
     var_haxid(pfileid,iv) = phoriid
   ELSE
@@ -1250 +1246 @@
 !-- Does the vertical coordinate exist ?
 !-
-    IF ( pzid > nb_zax(pfileid)) THEN
+    IF (pzid > nb_zax(pfileid)) THEN
       WRITE(str70, &
  &    '("The vertical coordinate chosen for variable ",a)') &
@@ -1261 +1257 @@
 !-
     IF (par_szz /= zax_size(pfileid,pzid)) THEN
-      str20 = zax_name(pfileid,pzid)
       str70 = "The size of the zoom does not correspond "// &
  &            "to the size of the chosen vertical axis"
       WRITE(str71,'("Size of zoom in z :", I4)') par_szz
       WRITE(str72,'("Size declared for axis ",A," :",I4)') &
- &     TRIM(str20), zax_size(pfileid,pzid)
+ &     TRIM(zax_name(pfileid,pzid)),zax_size(pfileid,pzid)
       CALL ipslerr (3,"histdef", str70, str71, str72)
     ENDIF
@@ -1272 +1267 @@
 !-- Is the zoom smaler that the total size of the variable ?
 !-
-    IF ( pzsize < par_szz ) THEN
-      str20 = zax_name(pfileid,pzid)
+    IF (pzsize < par_szz) THEN
       str70 = "The vertical size of variable "// &
  &            "is smaller than that of the zoom."
@@ -1321 +1315 @@
 !-
   CALL ioget_calendar(un_an, un_jour)
-  IF ( pfreq_opp < 0) THEN
+  IF (pfreq_opp < 0) THEN
     CALL ioget_calendar(un_an)
     test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
@@ -1327 +1321 @@
     test_fopp = pfreq_opp
   ENDIF
-  IF ( pfreq_wrt < 0) THEN
+  IF (pfreq_wrt < 0) THEN
     CALL ioget_calendar(un_an)
     test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
@@ -1370 +1364 @@
       str72 = "PATCH : The smalest frequency of both is used"
       CALL ipslerr (2,"histdef", str70, str71, str72)
-      IF ( test_fopp < test_fwrt) THEN
+      IF (test_fopp < test_fwrt) THEN
         freq_opp(pfileid,iv) = pfreq_opp
         freq_wrt(pfileid,iv) = pfreq_opp
@@ -1427 +1421 @@
   IF (check) WRITE(*,*) "histdef : 6.0"
 !-
-  IF ( freq_wrt(pfileid,iv) > 0 ) THEN
+  IF (freq_wrt(pfileid,iv) > 0) THEN
     WRITE(str10,'(I8.8)') INT(freq_wrt(pfileid,iv))
     str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
@@ -1434 +1428 @@
     str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
   ENDIF
-!-
-  tab_str40(1:nb_tax(pfileid)) = tax_name(pfileid,1:nb_tax(pfileid))
-  CALL find_str (tab_str40(1:nb_tax(pfileid)),str40,pos)
+  CALL find_str (tax_name(pfileid,1:nb_tax(pfileid)),str40,pos)
 !-
 ! No time axis for once, l_max, l_min or never operation
@@ -1444 +1436 @@
  &    .AND.(TRIM(tmp_topp) /= 'l_max') &
  &    .AND.(TRIM(tmp_topp) /= 'l_min') ) THEN
-    IF ( pos < 0) THEN
+    IF (pos < 0) THEN
       nb_tax(pfileid) = nb_tax(pfileid)+1
       tax_name(pfileid,nb_tax(pfileid)) = str40
@@ -1578 +1570 @@
     ttitle = title(pfileid,iv)
 !---
-    IF ( regular(pfileid) ) THEN
+    IF (regular(pfileid) ) THEN
       dims(1:2) = (/ xid(pfileid), yid(pfileid) /)
       dim_cnt = 2
@@ -1591 +1583 @@
 !   2.1 dimension of field
 !---
-    IF ( (TRIM(tmp_opp) /= 'never')) THEN
+    IF ((TRIM(tmp_opp) /= 'never')) THEN
       IF (     (TRIM(tmp_opp) /= 'once')  &
      &    .AND.(TRIM(tmp_opp) /= 'l_max') &
@@ -1617 +1609 @@
       ncvar_ids(pfileid,iv) = ncvarid
 !-
-      iret = NF90_PUT_ATT (ncid,ncvarid,'units',TRIM(tunit))
+      IF (LEN_TRIM(tunit) > 0) THEN
+        iret = NF90_PUT_ATT (ncid,ncvarid,'units',TRIM(tunit))
+      ENDIF
 !-
       iret = NF90_PUT_ATT (ncid,ncvarid,'missing_value', &
@@ -1651 +1645 @@
 !-
       IF (itax > 0) THEN
-        IF ( nb_tax(pfileid) > 1) THEN
+        IF (nb_tax(pfileid) > 1) THEN
           str30 = "t_"//tax_name(pfileid,itax)
         ELSE
@@ -1668 +1662 @@
  &                           REAL(freq_wrt(pfileid,iv),KIND=4))
       ENDIF
-      iret = NF90_PUT_ATT (ncid,ncvarid,'associate',TRIM(assoc))
+      iret = NF90_PUT_ATT (ncid,ncvarid,'coordinates',TRIM(assoc))
     ENDIF
   ENDDO
@@ -1678 +1672 @@
   ENDIF
 !-
-! 3.0 Put the netcdf file into wrte mode
+! 3.0 Put the netcdf file into write mode
 !-
   IF (check) WRITE(*,*) "histend : 3.0"
@@ -2199 +2193 @@
     ALLOCATE (buff_tmp2(datasz_max(pfileid,varid)))
     buff_tmp2_sz = datasz_max(pfileid,varid)
-  ELSE IF ( datasz_max(pfileid,varid) > buff_tmp2_sz) THEN
+  ELSE IF (datasz_max(pfileid,varid) > buff_tmp2_sz) THEN
     IF (check) THEN
       WRITE(*,*) "histwrite_real 1.2 re-allocate buff_tmp2 : ", &
@@ -2218 +2212 @@
 ! 3.1 DO the Operations only if needed
 !-
-  IF ( do_oper ) THEN
+  IF (do_oper) THEN
     i = pfileid
     nbout = nbdpt
@@ -2305 +2299 @@
   IF (check) WRITE(*,*) "histwrite: 6.0", pfileid
 !-
-  IF ( do_write ) THEN
+  IF (do_write) THEN
 !-
     ncvarid = ncvar_ids(pfileid,varid)
@@ -2327 +2321 @@
       IF (check) WRITE(*,*) "histwrite: 6.2", pfileid
 !-
-      itax = var_axid(pfileid, varid)
-      itime = nb_wrt(pfileid, varid)+1
+      itax = var_axid(pfileid,varid)
+      itime = nb_wrt(pfileid,varid)+1
 !-
       IF (tax_last(pfileid, itax) < itime) THEN
@@ -2357 +2351 @@
       ENDIF
     ELSE
-      IF ( regular(pfileid) ) THEN
+      IF (regular(pfileid)) THEN
         corner(1:4) = (/ 1, 1, 1, itime /)
         edges(1:4) = (/ zsize(pfileid,varid,1), &
@@ -2417 +2411 @@
   LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
   INTEGER,SAVE :: overlap(nb_files_max) = -1
-  INTEGER,SAVE :: varseq(nb_files_max, nb_var_max*3)
+  INTEGER,SAVE :: varseq(nb_files_max,nb_var_max*3)
   INTEGER,SAVE :: varseq_len(nb_files_max) = 0
   INTEGER,SAVE :: varseq_pos(nb_files_max)
   INTEGER,SAVE :: varseq_err(nb_files_max) = 0
-  INTEGER      :: ib, nb, sp, nx, pos
-  CHARACTER(LEN=20) :: str20
+  INTEGER      :: ib,sp,nx,pos
   CHARACTER(LEN=70) :: str70
 !-
   LOGICAL :: check = .FALSE.
 !---------------------------------------------------------------------
-  nb = nb_var(pfid)
-!-
   IF (check) THEN
     WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(pfid)
@@ -2448 +2439 @@
 !-- 1.1 Find the position of this string
 !-
-    str20 = pvarname
-    CALL find_str (name(pfid,1:nb),str20,pos)
-!-
+    CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
     IF (pos > 0) THEN
       pvid = pos
@@ -2457 +2446 @@
  &      'The name of the variable you gave has not been declared', &
  &      'You should use subroutine histdef for declaring variable', &
- &      TRIM(str20))
+ &      TRIM(pvarname))
     ENDIF
 !-
@@ -2463 +2452 @@
 !--     in the sequence of calls
 !-
-    IF ( varseq_err(pfid) .GE. 0 ) THEN
+    IF (varseq_err(pfid) >= 0) THEN
       sp = varseq_len(pfid)+1
       IF (sp <= nb_var_max*3) THEN
@@ -2509 +2498 @@
     IF (nx > varseq_len(pfid)) nx = 1
 !-
-    pvid = varseq(pfid, nx)
-!-
-    IF ( TRIM(name(pfid,pvid)) /= TRIM(pvarname) ) THEN
-      str20 = pvarname
-      CALL find_str (name(pfid,1:nb),str20,pos)
+    pvid = varseq(pfid,nx)
+!-
+    IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN
+      CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
       IF (pos > 0) THEN
         pvid = pos
@@ -2519 +2507 @@
         CALL ipslerr (3,"histvar_seq", &
  &  'The name of the variable you gave has not been declared',&
- &  'You should use subroutine histdef for declaring variable',str20)
+ &  'You should use subroutine histdef for declaring variable', &
+ &  TRIM(pvarname))
       ENDIF
       varseq_err(pfid) = varseq_err(pfid)+1
@@ -2577 +2566 @@
     ENDIF
 !-
-    IF ( file_exists ) THEN
+    IF (file_exists) THEN
       IF (check) THEN
         WRITE(*,*) 'Synchronising specified file number :', file
@@ -2624 +2613 @@
 !-- 1. Loop on the number of variables to add some final information
 !---
-    IF ( check ) WRITE(*,*) 'Entering loop on vars :', nb_var(ifile)
+    IF (check) WRITE(*,*) 'Entering loop on vars :', nb_var(ifile)
     DO iv=1,nb_var(ifile)
       IF (hist_wrt_rng(ifile,iv)) THEN
@@ -2643 +2632 @@
     ENDDO
 !---
-!-- 2.0 Close the file
+!-- 2. Close the file
 !---
-    IF (check) WRITE(*,*) 'close file :', ncid
+    IF (check) WRITE(*,*) 'close file :',ncid
     iret = NF90_CLOSE (ncid)
     IF (iret /= NF90_NOERR) THEN
       WRITE(str70,'("This file has been already closed :",I3)') ifile
-      CALL ipslerr (2,'histclo',str70,'',' ')
+      CALL ipslerr (2,'histclo',str70,'','')
     ENDIF
   ENDDO