Ignore:
Timestamp:
2009-08-05T16:53:12+02:00 (11 years ago)
Author:
smasson
Message:

ctlopn cleanup, see ticket:515 and ticket:237

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r1579 r1581  
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
    7    !! History :   1.0  !  2002-06  (G. Madec)  original code 
     7   !! History :   1.0  !  2002-06  (G. Madec)   original code 
    88   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn 
    9    !!             3.0  !  2008-06  (G. Madec)  add ctmp4 to ctmp10 
     9   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10 
     10   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn 
    1011   !!---------------------------------------------------------------------- 
    1112 
     
    1819   USE par_oce         ! ocean parameter 
    1920   USE lib_print       ! formated print library 
     21#if defined key_agrif 
     22   USE Agrif_Util 
     23#endif 
    2024 
    2125   IMPLICIT NONE 
     
    161165 
    162166 
     167   SUBROUTINE ctl_opn ( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea ) 
     168      !!---------------------------------------------------------------------- 
     169      !!                  ***  ROUTINE ctl_opn  *** 
     170      !! 
     171      !! ** Purpose :   Open file and check if required file is available. 
     172      !! 
     173      !! ** Method  :   Fortan open 
     174      !! 
     175      !! History : 
     176      !!        !  1995-12  (G. Madec)  Original code 
     177      !!   8.5  !  2002-06  (G. Madec)  F90: Free form and module 
     178      !!---------------------------------------------------------------------- 
     179 
     180      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open 
     181      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open 
     182      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier 
     183      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier 
     184      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier 
     185      INTEGER          , INTENT(in   ) ::   klengh    ! record length 
     186      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write 
     187      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print 
     188      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number 
     189      !! 
     190      CHARACTER(len=80) ::   clfile 
     191      INTEGER           ::   iost 
     192 
     193      ! adapt filename 
     194      ! ---------------- 
     195      clfile = TRIM(cdfile) 
     196      IF( PRESENT( karea ) ) THEN 
     197         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
     198      ENDIF 
     199#if defined key_agrif 
     200      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile) 
     201      knum=Agrif_Get_Unit() 
     202#else 
     203      knum=getunit() 
     204#endif 
     205 
     206      iost=0 
     207      IF( cdacce(1:6) == 'DIRECT' )  THEN 
     208         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost ) 
     209      ELSE 
     210         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost ) 
     211      ENDIF 
     212      IF( iost == 0 ) THEN 
     213         IF(ldwp) THEN 
     214            WRITE(kout,*) '     file   : ', clfile,' open ok' 
     215            WRITE(kout,*) '     unit   = ', knum 
     216            WRITE(kout,*) '     status = ', cdstat 
     217            WRITE(kout,*) '     form   = ', cdform 
     218            WRITE(kout,*) '     access = ', cdacce 
     219            WRITE(kout,*) 
     220         ENDIF 
     221      ENDIF 
     222100   CONTINUE 
     223      IF( iost /= 0 ) THEN 
     224         IF(ldwp) THEN 
     225            WRITE(kout,*) 
     226            WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile 
     227            WRITE(kout,*) ' =======   ===  ' 
     228            WRITE(kout,*) '           unit   = ', knum 
     229            WRITE(kout,*) '           status = ', cdstat 
     230            WRITE(kout,*) '           form   = ', cdform 
     231            WRITE(kout,*) '           access = ', cdacce 
     232            WRITE(kout,*) '           iostat = ', iost 
     233            WRITE(kout,*) '           we stop. verify the file ' 
     234            WRITE(kout,*) 
     235         ENDIF 
     236         STOP 'ctl_opn bad opening' 
     237      ENDIF 
     238       
     239   END SUBROUTINE ctl_opn 
     240 
     241 
    163242   FUNCTION getunit() 
    164243      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.