Changeset 5101 for LMDZ6/branches/Amaury_dev/libf/misc

Timestamp:

Jul 23, 2024, 8:22:55 AM (4 months ago)

Author:

abarral

Message:

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]

Location:

LMDZ6/branches/Amaury_dev/libf/misc

Files:

• ioipsl_errioipsl.F90 (modified) (1 diff)
• ioipsl_getincom.F90 (modified) (1 diff)
• j4save.F (modified) (1 diff)
• lmdz_cppkeys_wrapper.F90 (modified) (2 diffs)
• lmdz_mpi_wrappers.F90 (modified) (3 diffs)
• pchfe.F (modified) (1 diff)
• pchfe_95_m.F90 (modified) (1 diff)
• pchsp_95_m.F90 (modified) (1 diff)
• regr1_step_av_m.F90 (modified) (4 diffs)
• regr_lint_m.F90 (modified) (5 diffs)
• vampir.F90 (modified) (3 diffs)
• write_field.F90 (modified) (4 diffs)
• wxios.F90 (modified) (10 diffs)
• xercnt.F (modified) (2 diffs)
• xermsg.F (modified) (2 diffs)
• xgetua.F (modified) (1 diff)

LMDZ6/branches/Amaury_dev/libf/misc/ioipsl_errioipsl.F90

@@ -129 +129 @@
 !! the current level of the error messages
 !! and the maximum level encountered since the
-!! last call to "ipslerr_act".
+!! last CALL to "ipslerr_act".
 !!
 !! SUBROUTINE ipslerr_inq (current_level,maximum_level)

LMDZ6/branches/Amaury_dev/libf/misc/ioipsl_getincom.F90

@@ -11 +11 @@
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
 !---------------------------------------------------------------------
-USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_errioipsl, ONLY: ipslerr
 USE ioipsl_stringop, &
-     ONLY : nocomma,cmpblank,strlowercase
+     ONLY: nocomma,cmpblank,strlowercase
 !-
 IMPLICIT NONE

LMDZ6/branches/Amaury_dev/libf/misc/j4save.F

@@ -4 +4 @@
 C***BEGIN PROLOGUE  J4SAVE
 C***SUBSIDIARY
-C***PURPOSE  Save or recall global variables needed by error
+C***PURPOSE  Save or reCALL global variables needed by error
 C            handling routines.
 C***LIBRARY   SLATEC (XERROR)

LMDZ6/branches/Amaury_dev/libf/misc/lmdz_cppkeys_wrapper.F90

@@ -13 +13 @@
 
 MODULE lmdz_cppkeys_wrapper
-  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : REAL64, REAL32
+  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: REAL64, REAL32
   USE netcdf, ONLY: nf90_float, nf90_double
   IMPLICIT NONE; PRIVATE
-  PUBLIC nf90_format, CPPKEY_PHYS, CPPKEY_INCA, CPPKEY_STRATAER, CPPKEY_DUST
+  PUBLIC nf90_format, CPPKEY_PHYS, CPPKEY_INCA, CPPKEY_STRATAER, CPPKEY_DUST, &
+      CPPKEY_DEBUGIO
 
 #ifdef NC_DOUBLE
@@ -48 +49 @@
 #endif
 
+#ifdef DEBUG_IO
+  LOGICAL, PARAMETER :: CPPKEY_DEBUGIO = .TRUE.
+#else
+  LOGICAL, PARAMETER :: CPPKEY_DEBUGIO = .FALSE.
+#endif
+
 END MODULE lmdz_cppkeys_wrapper

LMDZ6/branches/Amaury_dev/libf/misc/lmdz_mpi_wrappers.F90

@@ -66 +66 @@
 
 SUBROUTINE MPI_WAITALL(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR)
-USE lmdz_mpi, ONLY : MPI_STATUS_SIZE
+USE lmdz_mpi, ONLY: MPI_STATUS_SIZE
 IMPLICIT NONE
     INTEGER    COUNT, ARRAY_OF_REQUESTS(*)
@@ -105 +105 @@
 
 SUBROUTINE MPI_ALLOC_MEM(SIZE, INFO, BASEPTR, IERROR)
-USE lmdz_mpi, ONLY : MPI_ADDRESS_KIND
+USE lmdz_mpi, ONLY: MPI_ADDRESS_KIND
 IMPLICIT NONE
     INTEGER INFO, IERROR
@@ -131 +131 @@
 SUBROUTINE MPI_RECV(BUF, COUNT, DATATYPE, SOURCE, TAG, COMM, STATUS, IERROR)
 USE ISO_C_BINDING
-USE lmdz_mpi, ONLY : MPI_STATUS_SIZE
+USE lmdz_mpi, ONLY: MPI_STATUS_SIZE
 IMPLICIT NONE
     TYPE(C_PTR),VALUE ::    BUF

LMDZ6/branches/Amaury_dev/libf/misc/pchfe.F

@@ -113 +113 @@
 C        b. Change the real declaration to double precision,
 C
-C     2. Most of the coding between the call to CHFEV and the end of
+C     2. Most of the coding between the CALL to CHFEV and the end of
 C        the IR-loop could be eliminated if it were permissible to
 C        assume that XE is ordered relative to X.

LMDZ6/branches/Amaury_dev/libf/misc/pchfe_95_m.F90

@@ -70 +70 @@
     n = assert_eq(size(x), size(f), size(d), "PCHFE_95 n")
     ne = assert_eq(size(xe), size(fe), "PCHFE_95 ne")
-    call PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
+    CALL PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
 
   end SUBROUTINE PCHFE_95

LMDZ6/branches/Amaury_dev/libf/misc/pchsp_95_m.F90

@@ -109 +109 @@
     if (present(vc_beg)) vc(1) = vc_beg
     if (present(vc_end)) vc(2) = vc_end
-    call PCHSP(IC, VC, N, X, F, pchsp_95, 1, WK, size(WK), IERR)
+    CALL PCHSP(IC, VC, N, X, F, pchsp_95, 1, WK, size(WK), IERR)
     if (ierr /= 0) stop 1
 

LMDZ6/branches/Amaury_dev/libf/misc/regr1_step_av_m.F90

@@ -55 +55 @@
     nt = size(xt) - 1
     ! Quick check on sort order:
-    call assert(xs(1) < xs(2), "regr11_step_av xs bad order")
-    call assert(xt(1) < xt(2), "regr11_step_av xt bad order")
-
-    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+    CALL assert(xs(1) < xs(2), "regr11_step_av xs bad order")
+    CALL assert(xt(1) < xt(2), "regr11_step_av xt bad order")
+
+    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
          "regr11_step_av extrapolation")
 
@@ -115 +115 @@
 
     ! Quick check on sort order:
-    call assert(xs(1) < xs(2), "regr12_step_av xs bad order")
-    call assert(xt(1) < xt(2), "regr12_step_av xt bad order")
-
-    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+    CALL assert(xs(1) < xs(2), "regr12_step_av xs bad order")
+    CALL assert(xt(1) < xt(2), "regr12_step_av xt bad order")
+
+    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
          "regr12_step_av extrapolation")
 
@@ -176 +176 @@
 
     ! Quick check on sort order:
-    call assert(xs(1) < xs(2), "regr13_step_av xs bad order")
-    call assert(xt(1) < xt(2), "regr13_step_av xt bad order")
-
-    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+    CALL assert(xs(1) < xs(2), "regr13_step_av xs bad order")
+    CALL assert(xt(1) < xt(2), "regr13_step_av xt bad order")
+
+    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
          "regr13_step_av extrapolation")
 
@@ -237 +237 @@
 
     ! Quick check on sort order:
-    call assert(xs(1) < xs(2), "regr14_step_av xs bad order")
-    call assert(xt(1) < xt(2), "regr14_step_av xt bad order")
-
-    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+    CALL assert(xs(1) < xs(2), "regr14_step_av xs bad order")
+    CALL assert(xt(1) < xt(2), "regr14_step_av xt bad order")
+
+    CALL assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
          "regr14_step_av extrapolation")
 

LMDZ6/branches/Amaury_dev/libf/misc/regr_lint_m.F90

@@ -49 +49 @@
 !-------------------------------------------------------------------------------
   CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first call to "hunt"
+  is = -1 ! go immediately to bisection on first CALL to "hunt"
   DO it=1,SIZE(xt)
     CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
@@ -78 +78 @@
 !-------------------------------------------------------------------------------
   CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first call to "hunt"
+  is = -1 ! go immediately to bisection on first CALL to "hunt"
   DO it=1,SIZE(xt)
     CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
@@ -108 +108 @@
 !-------------------------------------------------------------------------------
   CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first call to "hunt"
+  is = -1 ! go immediately to bisection on first CALL to "hunt"
   DO it=1,SIZE(xt)
     CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
@@ -139 +139 @@
 !-------------------------------------------------------------------------------
   CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first call to "hunt"
+  is = -1 ! go immediately to bisection on first CALL to "hunt"
   DO it=1,SIZE(xt)
     CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)
@@ -171 +171 @@
 !-------------------------------------------------------------------------------
   CALL check_size(ix,SHAPE(vs),SHAPE(vt),SIZE(xs),SIZE(xt),ns,nt)
-  is = -1 ! go immediately to bisection on first call to "hunt"
+  is = -1 ! go immediately to bisection on first CALL to "hunt"
   DO it=1,SIZE(xt)
     CALL hunt(xs,xt(it),is); isb=MIN(MAX(is,1),ns-1)

LMDZ6/branches/Amaury_dev/libf/misc/vampir.F90

@@ -22 +22 @@
     integer :: ierr
     
-    call VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
-    call VTSYMDEF(VTintegre,"integre","integre",ierr)
-    call VTSYMDEF(VTadvection,"advection","advection",ierr)
-    call VTSYMDEF(VTdissipation,"dissipation","dissipation",ierr)
-    call VTSYMDEF(VThallo,"hallo","hallo",ierr)
-    call VTSYMDEF(VTphysiq,"physiq","physiq",ierr)
-    call VTSYMDEF(VTinca,"inca","inca",ierr)
+    CALL VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
+    CALL VTSYMDEF(VTintegre,"integre","integre",ierr)
+    CALL VTSYMDEF(VTadvection,"advection","advection",ierr)
+    CALL VTSYMDEF(VTdissipation,"dissipation","dissipation",ierr)
+    CALL VTSYMDEF(VThallo,"hallo","hallo",ierr)
+    CALL VTSYMDEF(VTphysiq,"physiq","physiq",ierr)
+    CALL VTSYMDEF(VTinca,"inca","inca",ierr)
 #endif
 
@@ -56 +56 @@
     integer :: ierr
     
-    call VTBEGIN(number,ierr)
+    CALL VTBEGIN(number,ierr)
 #endif 
 #ifdef USE_MPE
@@ -73 +73 @@
     integer :: ierr
    
-    call VTEND(number,ierr)
+    CALL VTEND(number,ierr)
 #endif    
 

LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90

@@ -46 +46 @@
       
       Dim=shape(Field)
-      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3))  
+      CALL WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3))
   
     end subroutine WriteField3d
@@ -57 +57 @@
       
       Dim=shape(Field)
-      call WriteField_gen(name,Field,Dim(1),Dim(2),1)  
+      CALL WriteField_gen(name,Field,Dim(1),Dim(2),1)
   
     end subroutine WriteField2d
@@ -68 +68 @@
       
       Dim=shape(Field)
-      call WriteField_gen(name,Field,Dim(1),1,1)  
+      CALL WriteField_gen(name,Field,Dim(1),1,1)
   
     end subroutine WriteField1d
@@ -86 +86 @@
       Index=GetFieldIndex(name)
       if (Index==-1) then
-        call CreateNewField(name,dimx,dimy,dimz)
+        CALL CreateNewField(name,dimx,dimy,dimz)
         Index=GetFieldIndex(name)
       else

LMDZ6/branches/Amaury_dev/libf/misc/wxios.F90

@@ -95 +95 @@
 
     SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
-        USE print_control_mod, ONLY : prt_level, lunout
+        USE print_control_mod, ONLY: prt_level, lunout
         IMPLICIT NONE
 
@@ -137 +137 @@
 
     SUBROUTINE wxios_context_init()
-        USE print_control_mod, ONLY : prt_level, lunout
-        USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
+        USE print_control_mod, ONLY: prt_level, lunout
+        USE mod_phys_lmdz_mpi_data, ONLY: COMM_LMDZ_PHY
         IMPLICIT NONE
 
@@ -155 +155 @@
         IF (prt_level >= 10) THEN
           WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
-          WRITE(lunout,*) "     now call xios_solve_inheritance()"
+          WRITE(lunout,*) "     now CALL xios_solve_inheritance()"
         ENDIF
         !Une première analyse des héritages:
@@ -168 +168 @@
       ! routine create by Anne Cozic (2023)
       ! This routine will create field associated to group defined without description of fields in field.xml file
-      ! This routine need to be call before "xios_sole_inheritance" after an !$OMP MASTER directive 
+      ! This routine need to be CALL before "xios_sole_inheritance" after an !$OMP MASTER directive
       
       USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
@@ -291 +291 @@
 
     SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
-        USE print_control_mod, ONLY : prt_level, lunout
+        USE print_control_mod, ONLY: prt_level, lunout
         IMPLICIT NONE
 
@@ -364 +364 @@
                                      is_sequential, is_south_pole_dyn
        USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo         
-       USE print_control_mod, ONLY : prt_level, lunout
+       USE print_control_mod, ONLY: prt_level, lunout
        USE geometry_mod
 
@@ -446 +446 @@
 
     SUBROUTINE wxios_domain_param_unstructured(dom_id)
-        USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
-        USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
+        USE geometry_mod, ONLY: longitude, latitude, boundslon, boundslat,ind_cell_glo
+        USE mod_grid_phy_lmdz, ONLY: nvertex, klon_glo
         USE mod_phys_lmdz_para 
-        USE nrtype, ONLY : PI
-        USE ioipsl_getin_p_mod, ONLY : getin_p
+        USE nrtype, ONLY: PI
+        USE ioipsl_getin_p_mod, ONLY: getin_p
         IMPLICIT NONE
         CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
@@ -501 +501 @@
     SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value,     &
                                positif, bnds)
-        USE print_control_mod, ONLY : prt_level, lunout
+        USE print_control_mod, ONLY: prt_level, lunout
         IMPLICIT NONE
 
@@ -558 +558 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_add_file(fname, ffreq, flvl)
-        USE print_control_mod, ONLY : prt_level, lunout
+        USE print_control_mod, ONLY: prt_level, lunout
         IMPLICIT NONE
 
@@ -642 +642 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
-        USE print_control_mod, ONLY : prt_level, lunout
+        USE print_control_mod, ONLY: prt_level, lunout
         IMPLICIT NONE
 

LMDZ6/branches/Amaury_dev/libf/misc/xercnt.F

@@ -16 +16 @@
 C        Just after each message is recorded, but before it is
 C        processed any further (i.e., before it is printed or
-C        a decision to abort is made), a call is made to XERCNT.
+C        a decision to abort is made), a CALL is made to XERCNT.
 C        If the user has provided his own version of XERCNT, he
 C        can then override the value of KONTROL used in processing
@@ -32 +32 @@
 C        SUBROU - the subroutine that XERMSG is being called from
 C        MESSG  - the first 20 characters of the error message.
-C        NERR   - same as in the call to XERMSG.
-C        LEVEL  - same as in the call to XERMSG.
+C        NERR   - same as in the CALL to XERMSG.
+C        LEVEL  - same as in the CALL to XERMSG.
 C        KONTRL - the current value of the control flag as set
-C                 by a call to XSETF.
+C                 by a CALL to XSETF.
 C
 C      --Output--

LMDZ6/branches/Amaury_dev/libf/misc/xermsg.F

@@ -135 +135 @@
 C    Each of the arguments to XERMSG is input; none will be modified by
 C    XERMSG.  A routine may make multiple calls to XERMSG with warning
-C    level messages; however, after a call to XERMSG with a recoverable
+C    level messages; however, after a CALL to XERMSG with a recoverable
 C    error, the routine should return to the user.  Do not try to call
 C    XERMSG with a second recoverable error after the first recoverable
@@ -145 +145 @@
 C    This is considered harmless for error numbers associated with
 C    warning messages but must not be done for error numbers of serious
-C    errors.  After a call to XERMSG with a recoverable error, the user
-C    must be given a chance to call NUMXER or XERCLR to retrieve or
+C    errors.  After a CALL to XERMSG with a recoverable error, the user
+C    must be given a chance to CALL NUMXER or XERCLR to retrieve or
 C    clear the error number.
 C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC

LMDZ6/branches/Amaury_dev/libf/misc/xgetua.F

@@ -15 +15 @@
 C        XGETUA may be called to determine the unit number or numbers
 C        to which error messages are being sent.
-C        These unit numbers may have been set by a call to XSETUN,
-C        or a call to XSETUA, or may be a default value.
+C        These unit numbers may have been set by a CALL to XSETUN,
+C        or a CALL to XSETUA, or may be a default value.
 C
 C     Description of Parameters