Changeset 1581 for trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

Timestamp:

2009-08-05T16:53:12+02:00 (15 years ago)

Author:

smasson

Message:

ctlopn cleanup, see ticket:515 and ticket:237

File:

• trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90 (modified) (3 diffs)

trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

@@ -5 +5 @@
    !!                 turbulent closure parameterization
    !!=====================================================================
-   !! History :   1.0  !  2002-06  (G. Madec)  original code
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
    !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
-   !!             3.0  !  2008-06  (G. Madec)  add ctmp4 to ctmp10
+   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
+   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
    !!----------------------------------------------------------------------
 
@@ -18 +19 @@
    USE par_oce         ! ocean parameter
    USE lib_print       ! formated print library
+#if defined key_agrif
+   USE Agrif_Util
+#endif
 
    IMPLICIT NONE
@@ -161 +165 @@
 
 
+   SUBROUTINE ctl_opn ( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!
+      !! History :
+      !!        !  1995-12  (G. Madec)  Original code
+      !!   8.5  !  2002-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !!
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=getunit()
+#endif
+
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', clfile,' open ok'
+            WRITE(kout,*) '     unit   = ', knum
+            WRITE(kout,*) '     status = ', cdstat
+            WRITE(kout,*) '     form   = ', cdform
+            WRITE(kout,*) '     access = ', cdacce
+            WRITE(kout,*)
+         ENDIF
+      ENDIF
+100   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile
+            WRITE(kout,*) ' =======   ===  '
+            WRITE(kout,*) '           unit   = ', knum
+            WRITE(kout,*) '           status = ', cdstat
+            WRITE(kout,*) '           form   = ', cdform
+            WRITE(kout,*) '           access = ', cdacce
+            WRITE(kout,*) '           iostat = ', iost
+            WRITE(kout,*) '           we stop. verify the file '
+            WRITE(kout,*)
+         ENDIF
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      
+   END SUBROUTINE ctl_opn
+
+
    FUNCTION getunit()
       !!----------------------------------------------------------------------