Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2528 r2715 12 12 !!---------------------------------------------------------------------- 13 13 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 14 !!---------------------------------------------------------------------- 19 15 USE par_oce ! ocean parameter … … 134 130 !! $Id$ 135 131 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 136 !!----------------------------------------------------------------------137 CONTAINS138 139 SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5, &140 & cd6, cd7, cd8, cd9, cd10 )141 !!----------------------------------------------------------------------142 !! *** ROUTINE stop_opa ***143 !!144 !! ** Purpose : print in ocean.outpput file a error message and145 !! increment the error number (nstop) by one.146 !!----------------------------------------------------------------------147 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd1, cd2, cd3, cd4, cd5148 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10149 !!----------------------------------------------------------------------150 !151 nstop = nstop + 1152 IF(lwp) THEN153 WRITE(numout,cform_err)154 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1155 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2156 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3157 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4158 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5159 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6160 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7161 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8162 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9163 IF( PRESENT(cd10) ) WRITE(numout,*) cd10164 ENDIF165 CALL FLUSH(numout )166 IF( numstp /= -1 ) CALL FLUSH(numstp )167 IF( numsol /= -1 ) CALL FLUSH(numsol )168 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice)169 !170 END SUBROUTINE ctl_stop171 172 173 SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5, &174 & cd6, cd7, cd8, cd9, cd10 )175 !!----------------------------------------------------------------------176 !! *** ROUTINE stop_warn ***177 !!178 !! ** Purpose : print in ocean.outpput file a error message and179 !! increment the warning number (nwarn) by one.180 !!----------------------------------------------------------------------181 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd1, cd2, cd3, cd4, cd5182 CHARACTER(len=*), INTENT(in), OPTIONAL :: cd6, cd7, cd8, cd9, cd10183 !!----------------------------------------------------------------------184 !185 nwarn = nwarn + 1186 IF(lwp) THEN187 WRITE(numout,cform_war)188 IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1189 IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2190 IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3191 IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4192 IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5193 IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6194 IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7195 IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8196 IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9197 IF( PRESENT(cd10) ) WRITE(numout,*) cd10198 ENDIF199 CALL FLUSH(numout)200 !201 END SUBROUTINE ctl_warn202 203 204 SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )205 !!----------------------------------------------------------------------206 !! *** ROUTINE ctl_opn ***207 !!208 !! ** Purpose : Open file and check if required file is available.209 !!210 !! ** Method : Fortan open211 !!----------------------------------------------------------------------212 INTEGER , INTENT( out) :: knum ! logical unit to open213 CHARACTER(len=*) , INTENT(in ) :: cdfile ! file name to open214 CHARACTER(len=*) , INTENT(in ) :: cdstat ! disposition specifier215 CHARACTER(len=*) , INTENT(in ) :: cdform ! formatting specifier216 CHARACTER(len=*) , INTENT(in ) :: cdacce ! access specifier217 INTEGER , INTENT(in ) :: klengh ! record length218 INTEGER , INTENT(in ) :: kout ! number of logical units for write219 LOGICAL , INTENT(in ) :: ldwp ! boolean term for print220 INTEGER, OPTIONAL, INTENT(in ) :: karea ! proc number221 !!222 CHARACTER(len=80) :: clfile223 INTEGER :: iost224 !!----------------------------------------------------------------------225 226 ! adapt filename227 ! ----------------228 clfile = TRIM(cdfile)229 IF( PRESENT( karea ) ) THEN230 IF( karea > 1 ) WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1231 ENDIF232 #if defined key_agrif233 IF( .NOT. Agrif_Root() ) clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)234 knum=Agrif_Get_Unit()235 #else236 knum=getunit()237 #endif238 239 iost=0240 IF( cdacce(1:6) == 'DIRECT' ) THEN241 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )242 ELSE243 OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost )244 ENDIF245 IF( iost == 0 ) THEN246 IF(ldwp) THEN247 WRITE(kout,*) ' file : ', clfile,' open ok'248 WRITE(kout,*) ' unit = ', knum249 WRITE(kout,*) ' status = ', cdstat250 WRITE(kout,*) ' form = ', cdform251 WRITE(kout,*) ' access = ', cdacce252 WRITE(kout,*)253 ENDIF254 ENDIF255 100 CONTINUE256 IF( iost /= 0 ) THEN257 IF(ldwp) THEN258 WRITE(kout,*)259 WRITE(kout,*) ' ===>>>> : bad opening file: ', clfile260 WRITE(kout,*) ' ======= === '261 WRITE(kout,*) ' unit = ', knum262 WRITE(kout,*) ' status = ', cdstat263 WRITE(kout,*) ' form = ', cdform264 WRITE(kout,*) ' access = ', cdacce265 WRITE(kout,*) ' iostat = ', iost266 WRITE(kout,*) ' we stop. verify the file '267 WRITE(kout,*)268 ENDIF269 STOP 'ctl_opn bad opening'270 ENDIF271 272 END SUBROUTINE ctl_opn273 274 275 FUNCTION getunit()276 !!----------------------------------------------------------------------277 !! *** FUNCTION getunit ***278 !!279 !! ** Purpose : return the index of an unused logical unit280 !!----------------------------------------------------------------------281 INTEGER :: getunit282 LOGICAL :: llopn283 !!----------------------------------------------------------------------284 !285 getunit = 15 ! choose a unit that is big enough then it is not already used in NEMO286 llopn = .TRUE.287 DO WHILE( (getunit < 998) .AND. llopn )288 getunit = getunit + 1289 INQUIRE( unit = getunit, opened = llopn )290 END DO291 IF( (getunit == 999) .AND. llopn ) THEN292 CALL ctl_stop( 'getunit: All logical units until 999 are used...' )293 getunit = -1294 ENDIF295 !296 END FUNCTION getunit297 298 132 !!===================================================================== 299 133 END MODULE in_out_manager
Note: See TracChangeset
for help on using the changeset viewer.