Changeset 122 for IOIPSL/trunk/src

Timestamp:

08/03/07 15:42:20 (17 years ago)

Author:

bellier

Message:

JB: some cleaning (-> fortran 90)

Location:

IOIPSL/trunk/src

Files:

• histcom.f90 (modified) (17 diffs)
• restcom.f90 (modified) (8 diffs)
• stringop.f90 (modified) (1 diff)

IOIPSL/trunk/src/histcom.f90

@@ -106 +106 @@
   INTEGER,SAVE :: nb_zax(nb_files_max)=0
   INTEGER,DIMENSION(nb_files_max,nb_zax_max),SAVE :: &
-  &  zax_size,zax_ids,zax_name_length
+  &  zax_size,zax_ids
   CHARACTER(LEN=20),SAVE :: zax_name(nb_files_max,nb_zax_max)
 !-
@@ -112 +112 @@
 !-
   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  name_length,nbopp
+ &  nbopp
   CHARACTER(LEN=20),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
  &  name,unit_name
@@ -149 +149 @@
 !-
   INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  tdimid,tax_last,tax_name_length
+ &  tdimid,tax_last
   CHARACTER(LEN=40),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
  &  tax_name
@@ -824 +824 @@
   ncid = ncdf_ids(pfileid)
 !-
-  IF ( SIZE(plon_bounds, DIM=1) == pim ) THEN
-    nbbounds = SIZE(plon_bounds, DIM=2)
+  IF     ( SIZE(plon_bounds,DIM=1) == pim ) THEN
+    nbbounds = SIZE(plon_bounds,DIM=2)
     transp = .TRUE.
-  ELSEIF ( SIZE(plon_bounds, DIM=2) == pim ) THEN
-    nbbounds = SIZE(plon_bounds, DIM=1)
+  ELSEIF ( SIZE(plon_bounds,DIM=2) == pim ) THEN
+    nbbounds = SIZE(plon_bounds,DIM=1)
     transp = .FALSE.
   ELSE
@@ -980 +980 @@
 !-
   INTEGER :: pos, iv, nb, zdimid, zaxid_tmp
-  CHARACTER(LEN=20) :: str20, tab_str20(nb_zax_max)
-  INTEGER tab_str20_length(nb_zax_max)
+  CHARACTER(LEN=20) :: str20
   CHARACTER(LEN=70) :: str70, str71, str72
   CHARACTER(LEN=80) :: str80
@@ -1029 +1028 @@
     str20 = pzaxname
     nb = iv-1
-    tab_str20(1:nb) = zax_name(pfileid,1:nb)
-    tab_str20_length(1:nb) = zax_name_length(pfileid,1:nb)
-    CALL find_str(nb, tab_str20, tab_str20_length, str20, pos)
+    CALL find_str (zax_name(pfileid,1:nb),str20,pos)
   ELSE
     pos = 0
@@ -1038 +1035 @@
   IF ( pos > 0) THEN
     str70 = "Vertical axis already exists"
-    WRITE(str71,'("Check variable ",a," in file",I3)') str20,pfileid
+    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)
@@ -1085 +1082 @@
   zax_size(pfileid, iv) = pzsize
   zax_name(pfileid, iv) = pzaxname
-  zax_name_length(pfileid, iv) = LEN_TRIM(pzaxname)
   zax_ids(pfileid, iv) = zaxid_tmp
   pzaxid =  iv
@@ -1155 +1151 @@
   CHARACTER(LEN=70) :: str70, str71, str72
   CHARACTER(LEN=20) :: tmp_name
-  CHARACTER(LEN=20) :: str20, tab_str20(nb_var_max)
-  INTEGER :: tab_str20_length(nb_var_max)
+  CHARACTER(LEN=20) :: str20
   CHARACTER(LEN=40) :: str40, tab_str40(nb_var_max)
-  INTEGER :: tab_str40_length(nb_var_max)
   CHARACTER(LEN=10) :: str10
   CHARACTER(LEN=80) :: tmp_str80
@@ -1188 +1182 @@
     str20 = pvarname
     nb = iv-1
-    tab_str20(1:nb) = name(pfileid,1:nb)
-    tab_str20_length(1:nb) = name_length(pfileid,1:nb)
-    CALL find_str (nb, tab_str20, tab_str20_length, str20, pos)
+    CALL find_str (name(pfileid,1:nb),str20,pos)
   ELSE
     pos = 0
@@ -1203 +1195 @@
 !-
   name(pfileid,iv) = pvarname
-  name_length(pfileid,iv) = LEN_TRIM(name(pfileid,iv))
   title(pfileid,iv) = ptitle
   unit_name(pfileid,iv) = punit
@@ -1306 +1297 @@
  &            "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)') &
+      WRITE(str72,'("Size declared for axis ",A," :",I4)') &
  &     TRIM(str20), zax_size(pfileid,pzid)
       CALL ipslerr (3,"histdef", str70, str71, str72)
@@ -1476 +1467 @@
   ENDIF
 !-
-  DO i=1,nb_tax(pfileid)
-    tab_str40(i) = tax_name(pfileid,i)
-    tab_str40_length(i) = tax_name_length(pfileid,i)
-  ENDDO
-!-
-  CALL find_str (nb_tax(pfileid),tab_str40,tab_str40_length,str40,pos)
+  tab_str40(1:nb_tax(pfileid)) = tax_name(pfileid,1:nb_tax(pfileid))
+  CALL find_str (tab_str40(1:nb_tax(pfileid)),str40,pos)
 !-
 ! No time axis for once, l_max, l_min or never operation
@@ -1492 +1479 @@
       nb_tax(pfileid) = nb_tax(pfileid)+1
       tax_name(pfileid,nb_tax(pfileid)) = str40
-      tax_name_length(pfileid, nb_tax(pfileid)) = LEN_TRIM(str40)
       tax_last(pfileid,nb_tax(pfileid)) = 0
       var_axid(pfileid,iv) = nb_tax(pfileid)
@@ -2471 +2457 @@
   INTEGER,SAVE :: varseq_err(nb_files_max) = 0
   INTEGER      :: ib, nb, sp, nx, pos
-  CHARACTER(LEN=20),DIMENSION(nb_var_max) :: tab_str20
   CHARACTER(LEN=20) :: str20
   CHARACTER(LEN=70) :: str70
-  INTEGER      :: tab_str20_length(nb_var_max)
 !-
   LOGICAL :: check = .FALSE.
@@ -2500 +2484 @@
 !-
     str20 = pvarname
-    tab_str20(1:nb) = name(pfid,1:nb)
-    tab_str20_length(1:nb) = name_length(pfid,1:nb)
-!-
-    CALL find_str (nb, tab_str20, tab_str20_length, str20, pos)
+    CALL find_str (name(pfid,1:nb),str20,pos)
 !-
     IF (pos > 0) THEN
@@ -2565 +2546 @@
     pvid = varseq(pfid, nx)
 !-
-    IF (    (INDEX(name(pfid,pvid),pvarname) <= 0)         &
-   &    .OR.(name_length(pfid,pvid) /= len_trim(pvarname)) ) THEN
+    IF ( TRIM(name(pfid,pvid)) /= TRIM(pvarname) ) THEN
       str20 = pvarname
-      tab_str20(1:nb) = name(pfid,1:nb)
-      tab_str20_length(1:nb) = name_length(pfid,1:nb)
-      CALL find_str (nb,tab_str20,tab_str20_length,str20,pos)
+      CALL find_str (name(pfid,1:nb),str20,pos)
       IF (pos > 0) THEN
         pvid = pos

IOIPSL/trunk/src/restcom.f90

@@ -126 +126 @@
  &  varname_in,varname_out
   INTEGER,DIMENSION(max_file,max_var),SAVE :: &
- &  varname_in_length,varname_out_length, &
  &  varid_in,varid_out,varnbdim_in,varatt_in
   INTEGER,DIMENSION(max_file,max_var,max_dim),SAVE :: &
@@ -357 +356 @@
     netcdf_id(nbfiles,2) = netcdf_id(nbfiles,1)
     varname_out(nbfiles,:) = varname_in(nbfiles,:) 
-    varname_out_length(nbfiles,:) = varname_in_length(nbfiles,:) 
     nbvar_out(nbfiles) = nbvar_in(nbfiles) 
     tind_varid_out(nbfiles) = tind_varid_in(nbfiles) 
@@ -550 +548 @@
     ENDDO
 !---
-    varname_in_length(fid,iv) = LEN_TRIM(varname_in(fid,iv))
-!---
 !-- 2.1 Read the units of the variable
 !---
@@ -1487 +1483 @@
   ncfid = netcdf_id(fid,1)
 !-
-  CALL find_str &
-    (nbvar_in(fid),varname_in(fid,1:nbvar_in(fid)), &
-     varname_in_length(fid,1:nbvar_in(fid)),vname_q,vnb)
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
 !-
 ! 1.0 If the variable is not present then ERROR or filled up
@@ -1513 +1507 @@
       vnb = nbvar_in(fid)
       varname_in(fid,vnb) = vname_q
-      varname_in_length(fid,vnb) = LEN_TRIM(vname_q)
       touched_in(fid,vnb) = .TRUE.
 !-----
@@ -2118 +2111 @@
   IF (check) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
 !-
-  CALL find_str &
-    (nbvar_out(fid),varname_out(fid,1:nbvar_out(fid)), &
-     varname_out_length(fid,1:nbvar_out(fid)),vname_q,vnb)
+  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
 !-
   IF (check) THEN
@@ -2265 +2256 @@
   nbvar_out(fid) = nbvar_out(fid)+1
   varname_out(fid,nbvar_out(fid)) = varname
-  varname_out_length(fid,nbvar_out(fid)) = LEN_TRIM(varname)
 !-
 ! 0.0 Put the file in define mode if needed
@@ -2441 +2431 @@
 !---------------------------------------------------------------------
 ! Find the index of the variable
-  CALL find_str &
-    (nbvar_in(fid),varname_in(fid,1:nbvar_in(fid)), &
-     varname_in_length(fid,1:nbvar_in(fid)),vname_q,vnb)
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
 !-
   IF (vnb > 0) THEN

IOIPSL/trunk/src/stringop.f90

@@ -76 +76 @@
 END FUNCTION findpos
 !===
-SUBROUTINE find_str (nb_str,str_tab,str_len_tab,str,pos)
+SUBROUTINE find_str (str_tab,str,pos)
 !---------------------------------------------------------------------
 !- This subroutine looks for a string in a table
 !---------------------------------------------------------------------
 !- INPUT
-!-   nb_str      : length of table
-!-   str_tab     : Table  of strings
-!-   str_len_tab : Table  of string-length
-!-   str         : Target we are looking for
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
 !- OUTPUT
-!-   pos         : -1 if str not found, else value in the table
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb_str
-  CHARACTER(LEN=*),DIMENSION(nb_str) :: str_tab
-  INTEGER,DIMENSION(nb_str) :: str_len_tab
-  CHARACTER(LEN=*) :: str
-  INTEGER :: pos
-!-
-  INTEGER :: i,il
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
 !---------------------------------------------------------------------
   pos = -1
-  il = LEN_TRIM(str)
+  nb_str=SIZE(str_tab)
   IF ( nb_str > 0 ) THEN
     DO i=1,nb_str
-      IF (     (INDEX(str_tab(i),str(1:il)) > 0) &
-          .AND.(str_len_tab(i) == il) ) THEN
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
         pos = i
         EXIT