- Timestamp:
- 2011-03-01T20:04:06+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2625 r2636 13 13 14 14 !!---------------------------------------------------------------------- 15 !! ctl_stop : update momentum and tracer Kz from a tke scheme16 !! ctl_warn : initialization, namelist read, and parameters control17 !! getunit : give the index of an unused logical unit18 !!----------------------------------------------------------------------19 15 USE par_oce ! ocean parameter 20 16 USE lib_print ! formated print library 21 17 USE nc4interface ! NetCDF4 interface 22 USE lib_mpp ! MPP library23 18 24 19 IMPLICIT NONE … … 135 130 !! $Id$ 136 131 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 137 !!----------------------------------------------------------------------138 CONTAINS139 140 SUBROUTINE ctl_stop( cd_stop, cd1, cd2, cd3, cd4, cd5 , &141 & cd6, cd7, cd8, cd9, cd10 )142 !!----------------------------------------------------------------------143 !! *** ROUTINE stop_opa ***144 !!145 !! ** Purpose : print in ocean.outpput file a error message and146 !! increment the error number (nstop) by one.147 !!----------------------------------------------------------------------148 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd_stop, cd1, cd2, cd3, cd4, cd5149 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10150 !!----------------------------------------------------------------------151 !152 nstop = nstop + 1153 IF(lwp) THEN154 WRITE(numout,cform_err)155 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1156 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2157 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3158 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4159 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5160 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6161 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7162 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8163 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9164 IF( PRESENT(cd10) ) WRITE(numout,*) cd10165 ENDIF166 CALL FLUSH(numout )167 IF( numstp /= -1 ) CALL FLUSH(numstp )168 IF( numsol /= -1 ) CALL FLUSH(numsol )169 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice)170 !171 IF( PRESENT(cd_stop) ) THEN172 IF( cd_stop == 'STOP' ) THEN173 WRITE(numout,*)174 WRITE(numout,*) 'huge E-R-R-O-R : immediate stop'175 CALL mppstop()176 ENDIF177 ENDIF178 !179 END SUBROUTINE ctl_stop180 181 182 SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5, &183 & cd6, cd7, cd8, cd9, cd10 )184 !!----------------------------------------------------------------------185 !! *** ROUTINE stop_warn ***186 !!187 !! ** Purpose : print in ocean.outpput file a error message and188 !! increment the warning number (nwarn) by one.189 !!----------------------------------------------------------------------190 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd1, cd2, cd3, cd4, cd5191 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10192 !!----------------------------------------------------------------------193 !194 nwarn = nwarn + 1195 IF(lwp) THEN196 WRITE(numout,cform_war)197 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1198 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2199 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3200 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4201 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5202 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6203 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7204 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8205 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9206 IF( PRESENT(cd10) ) WRITE(numout,*) cd10207 ENDIF208 CALL FLUSH(numout)209 !210 END SUBROUTINE ctl_warn211 212 213 SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )214 !!----------------------------------------------------------------------215 !! *** ROUTINE ctl_opn ***216 !!217 !! ** Purpose : Open file and check if required file is available.218 !!219 !! ** Method : Fortan open220 !!----------------------------------------------------------------------221 INTEGER , INTENT( out) :: knum ! logical unit to open222 CHARACTER(len=*) , INTENT(in ) :: cdfile ! file name to open223 CHARACTER(len=*) , INTENT(in ) :: cdstat ! disposition specifier224 CHARACTER(len=*) , INTENT(in ) :: cdform ! formatting specifier225 CHARACTER(len=*) , INTENT(in ) :: cdacce ! access specifier226 INTEGER , INTENT(in ) :: klengh ! record length227 INTEGER , INTENT(in ) :: kout ! number of logical units for write228 LOGICAL , INTENT(in ) :: ldwp ! boolean term for print229 INTEGER, OPTIONAL, INTENT(in ) :: karea ! proc number230 !!231 CHARACTER(len=80) :: clfile232 INTEGER :: iost233 !!----------------------------------------------------------------------234 235 ! adapt filename236 ! ----------------237 clfile = TRIM(cdfile)238 IF( PRESENT( karea ) ) THEN239 IF( karea > 1 ) WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1240 ENDIF241 #if defined key_agrif242 IF( .NOT. Agrif_Root() ) clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)243 knum=Agrif_Get_Unit()244 #else245 knum=getunit()246 #endif247 248 iost=0249 IF( cdacce(1:6) == 'DIRECT' ) THEN250 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )251 ELSE252 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost )253 ENDIF254 IF( iost == 0 ) THEN255 IF(ldwp) THEN256 WRITE(kout,*) ' file : ', clfile,' open ok'257 WRITE(kout,*) ' unit = ', knum258 WRITE(kout,*) ' status = ', cdstat259 WRITE(kout,*) ' form = ', cdform260 WRITE(kout,*) ' access = ', cdacce261 WRITE(kout,*)262 ENDIF263 ENDIF264 100 CONTINUE265 IF( iost /= 0 ) THEN266 IF(ldwp) THEN267 WRITE(kout,*)268 WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile269 WRITE(kout,*) ' ======= === '270 WRITE(kout,*) ' unit = ', knum271 WRITE(kout,*) ' status = ', cdstat272 WRITE(kout,*) ' form = ', cdform273 WRITE(kout,*) ' access = ', cdacce274 WRITE(kout,*) ' iostat = ', iost275 WRITE(kout,*) ' we stop. verify the file '276 WRITE(kout,*)277 ENDIF278 STOP 'ctl_opn bad opening'279 ENDIF280 281 END SUBROUTINE ctl_opn282 283 284 FUNCTION getunit()285 !!----------------------------------------------------------------------286 !! *** FUNCTION getunit ***287 !!288 !! ** Purpose : return the index of an unused logical unit289 !!----------------------------------------------------------------------290 INTEGER :: getunit291 LOGICAL :: llopn292 !!----------------------------------------------------------------------293 !294 getunit = 15 ! choose a unit that is big enough then it is not already used in NEMO295 llopn = .TRUE.296 DO WHILE( (getunit < 998) .AND. llopn )297 getunit = getunit + 1298 INQUIRE( unit = getunit, opened = llopn )299 END DO300 IF( (getunit == 999) .AND. llopn ) THEN301 CALL ctl_stop( 'getunit: All logical units until 999 are used...' )302 getunit = -1303 ENDIF304 !305 END FUNCTION getunit306 307 132 !!===================================================================== 308 133 END MODULE in_out_manager
Note: See TracChangeset
for help on using the changeset viewer.