- Timestamp:
- 2019-12-12T09:59:50+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/LBC/lib_mpp.F90
r11536 r12202 32 32 !! ctl_opn : Open file and check if required file is available. 33 33 !! ctl_nam : Prints informations when an error occurs while reading a namelist 34 !! load_nml : Read, condense and buffer namelist file into character array for use as an internal file 34 35 !!---------------------------------------------------------------------- 35 36 !!---------------------------------------------------------------------- … … 50 51 !! mpp_ini_north : initialisation of north fold 51 52 !! mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs 53 !! mpp_bcast_nml : broadcast/receive namelist character buffer from reading process to all others 52 54 !!---------------------------------------------------------------------- 53 55 USE dom_oce ! ocean space and time domain … … 57 59 PRIVATE 58 60 ! 59 PUBLIC ctl_stop, ctl_warn, ctl_opn, ctl_nam 61 PUBLIC ctl_stop, ctl_warn, ctl_opn, ctl_nam, load_nml 60 62 PUBLIC mpp_start, mppstop, mppsync, mpp_comm_free 61 63 PUBLIC mpp_ini_north … … 66 68 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 67 69 PUBLIC mpp_report 70 PUBLIC mpp_bcast_nml 68 71 PUBLIC tic_tac 69 72 #if ! defined key_mpp_mpi … … 499 502 #endif 500 503 END SUBROUTINE mpp_delay_rcv 504 505 SUBROUTINE mpp_bcast_nml( cdnambuff , kleng ) 506 CHARACTER(LEN=:) , ALLOCATABLE, INTENT(INOUT) :: cdnambuff 507 INTEGER , INTENT(INOUT) :: kleng 508 !!---------------------------------------------------------------------- 509 !! *** routine mpp_bcast_nml *** 510 !! 511 !! ** Purpose : broadcast namelist character buffer 512 !! 513 !!---------------------------------------------------------------------- 514 !! 515 INTEGER :: iflag 516 !!---------------------------------------------------------------------- 517 ! 518 #if defined key_mpp_mpi 519 call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag) 520 call MPI_BARRIER(mpi_comm_oce, iflag) 521 !$AGRIF_DO_NOT_TREAT 522 IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng) :: cdnambuff ) 523 !$AGRIF_END_DO_NOT_TREAT 524 call MPI_BCAST(cdnambuff, kleng, MPI_CHARACTER, 0, mpi_comm_oce, iflag) 525 call MPI_BARRIER(mpi_comm_oce, iflag) 526 #endif 527 ! 528 END SUBROUTINE mpp_bcast_nml 501 529 502 530 … … 1068 1096 1069 1097 !!---------------------------------------------------------------------- 1070 !! ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam routines1098 !! ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam, load_nml routines 1071 1099 !!---------------------------------------------------------------------- 1072 1100 … … 1204 1232 & OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat , ERR=100, IOSTAT=iost ) 1205 1233 IF( iost == 0 ) THEN 1206 IF(ldwp ) THEN1234 IF(ldwp .AND. kout > 0) THEN 1207 1235 WRITE(kout,*) ' file : ', TRIM(clfile),' open ok' 1208 1236 WRITE(kout,*) ' unit = ', knum … … 1279 1307 END FUNCTION get_unit 1280 1308 1309 SUBROUTINE load_nml( cdnambuff , cdnamfile, kout, ldwp) 1310 CHARACTER(LEN=:) , ALLOCATABLE, INTENT(INOUT) :: cdnambuff 1311 CHARACTER(LEN=*), INTENT(IN ) :: cdnamfile 1312 CHARACTER(LEN=256) :: chline 1313 CHARACTER(LEN=1) :: csp 1314 INTEGER, INTENT(IN) :: kout 1315 LOGICAL, INTENT(IN) :: ldwp !: .true. only for the root broadcaster 1316 INTEGER :: itot, iun, iltc, inl, ios, itotsav 1317 ! 1318 !csp = NEW_LINE('A') 1319 ! a new line character is the best seperator but some systems (e.g.Cray) 1320 ! seem to terminate namelist reads from internal files early if they 1321 ! encounter new-lines. Use a single space for safety. 1322 csp = ' ' 1323 ! 1324 ! Check if the namelist buffer has already been allocated. Return if it has. 1325 ! 1326 IF ( ALLOCATED( cdnambuff ) ) RETURN 1327 IF( ldwp ) THEN 1328 ! 1329 ! Open namelist file 1330 ! 1331 CALL ctl_opn( iun, cdnamfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, kout, ldwp ) 1332 ! 1333 ! First pass: count characters excluding comments and trimable white space 1334 ! 1335 itot=0 1336 10 READ(iun,'(A256)',END=20,ERR=20) chline 1337 iltc = LEN_TRIM(chline) 1338 IF ( iltc.GT.0 ) THEN 1339 inl = INDEX(chline, '!') 1340 IF( inl.eq.0 ) THEN 1341 itot = itot + iltc + 1 ! +1 for the newline character 1342 ELSEIF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl-1) ).GT.0 ) THEN 1343 itot = itot + inl ! includes +1 for the newline character 1344 ENDIF 1345 ENDIF 1346 GOTO 10 1347 20 CONTINUE 1348 ! 1349 ! Allocate text cdnambuff for condensed namelist 1350 ! 1351 !$AGRIF_DO_NOT_TREAT 1352 ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff ) 1353 !$AGRIF_END_DO_NOT_TREAT 1354 itotsav = itot 1355 ! 1356 ! Second pass: read and transfer pruned characters into cdnambuff 1357 ! 1358 REWIND(iun) 1359 itot=1 1360 30 READ(iun,'(A256)',END=40,ERR=40) chline 1361 iltc = LEN_TRIM(chline) 1362 IF ( iltc.GT.0 ) THEN 1363 inl = INDEX(chline, '!') 1364 IF( inl.eq.0 ) THEN 1365 inl = iltc 1366 ELSE 1367 inl = inl - 1 1368 ENDIF 1369 IF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl) ).GT.0 ) THEN 1370 cdnambuff(itot:itot+inl-1) = chline(1:inl) 1371 WRITE( cdnambuff(itot+inl:itot+inl), '(a)' ) csp 1372 itot = itot + inl + 1 1373 ENDIF 1374 ENDIF 1375 GOTO 30 1376 40 CONTINUE 1377 itot = itot - 1 1378 IF( itotsav .NE. itot ) WRITE(*,*) 'WARNING in load_nml. Allocated ',itotsav,' for read buffer; but used ',itot 1379 ! 1380 ! Close namelist file 1381 ! 1382 CLOSE(iun) 1383 !write(*,'(32A)') cdnambuff 1384 ENDIF 1385 #if defined key_mpp_mpi 1386 CALL mpp_bcast_nml( cdnambuff, itot ) 1387 #endif 1388 END SUBROUTINE load_nml 1389 1390 1281 1391 !!---------------------------------------------------------------------- 1282 1392 END MODULE lib_mpp
Note: See TracChangeset
for help on using the changeset viewer.