Changeset 1391 for trunk/LMDZ.COMMON/libf/bibio

Timestamp:

Mar 6, 2015, 3:12:12 PM (10 years ago)

Author:

emillour

Message:

Common dynamical core:
Updates in the dynamics to keeup up with updates in LMDZ5
(up to LMDZ5 trunk rev 2200):

• compilation:
• create_make_gcm : added processing of .f & .f90 files (not just .F and .F90)
• makelmdz: add "mix" option for -io (ouptut with both IOIPSL and XIOS)
• makelmdz_fcm: add "mix" option for -io

• filtrez:
• acc.F and eigen.F : add "implicit none" and variable declarations

• bibio:
• handle_err_m.F90: replace "stop" with call to abort_gcm()
• i1mach.F, j4save.F: add "implicit none" and variable declarations
• xercnt.F, xermsg.F, xerprn.F, xersve.F, xgetua.F: add "implicit none" and variable declarations

• dyn3d_common:
• disvert.F90 : added comments on meaning of "pa" variable
• grid_atob.F : better control on level of default ouputs
• infotrac.F90: update Earth-specific stuff (nqo water tracers)
• interpre.F: correction on the size of input array w
• juldate.F, massbar.F, ppm3d.F, ran1.F: add "implicit none" and variable declarations
• sortvarc.F: code cleanup
• iniacademic.F90: cleanup and extra sanity check.

• dyn3d:
• abort_gcm.F: additions for XIOS
• conf_gcm.F90: transformed to free form from conf_gcm.F
• gcm.F: added test to check that iphysiq is a multiple of iperiod
• getparam.F90, guidz_mod.F: update from LMDZ5
• integrd.F: replace stop with call_abort()

• dyn3dpar:
• abort_gcm.F: minor cleanup
• gcm.F: added test to check that iphysiq is a multiple of iperiod
• getparam.F90, guide_p_mod.F90: update from LMDZ5
• integrd_p.F: abort with call_abort when there is negative surface pressure
• leapfrog_p.F: add INCA specific stuff to keep up with current LMDZ5
• conf_gcm.F90: transformed to free form from conf_gcm.F

EM

Location:

trunk/LMDZ.COMMON/libf/bibio

Files:

• handle_err_m.F90 (modified) (1 diff)
• i1mach.F (modified) (2 diffs)
• j4save.F (modified) (2 diffs)
• xercnt.F (modified) (2 diffs)
• xermsg.F (modified) (2 diffs)
• xerprn.F (modified) (2 diffs)
• xersve.F (modified) (3 diffs)
• xgetua.F (modified) (2 diffs)

trunk/LMDZ.COMMON/libf/bibio/handle_err_m.F90

@@ -39 +39 @@
           end if
        end if
-       stop 1
+       call abort_gcm("NetCDF95 handle_err", "", 1)
     end if
 

trunk/LMDZ.COMMON/libf/bibio/i1mach.F

@@ -1 +1 @@
 *DECK I1MACH
       INTEGER FUNCTION I1MACH (I)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  I1MACH
 C***PURPOSE  Return integer machine dependent constants.
@@ -95 +96 @@
       SAVE IMACH
       EQUIVALENCE (IMACH(4),OUTPUT)
+      INTEGER I
 C***FIRST EXECUTABLE STATEMENT  I1MACH
       IMACH( 1) =         5

trunk/LMDZ.COMMON/libf/bibio/j4save.F

@@ -1 +1 @@
 *DECK J4SAVE
       FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  J4SAVE
 C***SUBSIDIARY
@@ -59 +60 @@
       DATA IPARAM(5)/1/
       DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
+      INTEGER J4SAVE,IWHICH,IVALUE
 C***FIRST EXECUTABLE STATEMENT  J4SAVE
       J4SAVE = IPARAM(IWHICH)

trunk/LMDZ.COMMON/libf/bibio/xercnt.F

@@ -1 +1 @@
 *DECK XERCNT
       SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  XERCNT
 C***SUBSIDIARY
@@ -56 +57 @@
 C***END PROLOGUE  XERCNT
       CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      INTEGER NERR, LEVEL, KONTRL
 C***FIRST EXECUTABLE STATEMENT  XERCNT
       RETURN

trunk/LMDZ.COMMON/libf/bibio/xermsg.F

@@ -1 +1 @@
 *DECK XERMSG
       SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  XERMSG
 C***PURPOSE  Process error messages for SLATEC and other libraries.
@@ -189 +190 @@
       CHARACTER*72  TEMP
       CHARACTER*20  LFIRST
+      INTEGER NERR, LEVEL, LKNTRL
+      INTEGER J4SAVE, MAXMES, KDUMMY, I, KOUNT, LERR, LLEVEL
+      INTEGER MKNTRL, LTEMP
 C***FIRST EXECUTABLE STATEMENT  XERMSG
       LKNTRL = J4SAVE (2, 0, .FALSE.)

trunk/LMDZ.COMMON/libf/bibio/xerprn.F

@@ -1 +1 @@
 *DECK XERPRN
       SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  XERPRN
 C***SUBSIDIARY
@@ -81 +82 @@
       CHARACTER*2 NEWLIN
       PARAMETER (NEWLIN = '$$')
+      INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC
+      INTEGER LPIECE, IDELTA
 C***FIRST EXECUTABLE STATEMENT  XERPRN
       CALL XGETUA(IU,NUNIT)

trunk/LMDZ.COMMON/libf/bibio/xersve.F

@@ -2 +2 @@
       SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
      +   ICOUNT)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  XERSVE
 C***SUBSIDIARY
@@ -58 +59 @@
 C   920501  Reformatted the REFERENCES section.  (WRB)
 C***END PROLOGUE  XERSVE
-      PARAMETER (LENTAB=10)
+      INTEGER,PARAMETER :: LENTAB=10
       INTEGER LUN(5)
       CHARACTER*(*) LIBRAR, SUBROU, MESSG
@@ -66 +67 @@
       SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
       DATA KOUNTX/0/, NMSG/0/
+      INTEGER NERR,LEVEL,KONTRL
+      INTEGER NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
+      INTEGER KFLAG, ICOUNT, NUNIT, KUNIT, IUNIT, I1MACH, I
 C***FIRST EXECUTABLE STATEMENT  XERSVE
 C

trunk/LMDZ.COMMON/libf/bibio/xgetua.F

@@ -1 +1 @@
 *DECK XGETUA
       SUBROUTINE XGETUA (IUNITA, N)
+      IMPLICIT NONE
 C***BEGIN PROLOGUE  XGETUA
 C***PURPOSE  Return unit number(s) to which error messages are being
@@ -41 +42 @@
 C***END PROLOGUE  XGETUA
       DIMENSION IUNITA(5)
+      INTEGER IUNITA, N, J4SAVE, INDEX, I
 C***FIRST EXECUTABLE STATEMENT  XGETUA
       N = J4SAVE(5,0,.FALSE.)