- Timestamp:
- 2013-11-04T12:51:55+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3799 r4147 28 28 !! ctl_warn : initialization, namelist read, and parameters control 29 29 !! ctl_opn : Open file and check if required file is available. 30 !! get_unit : give the index of an unused logical unit 30 !! ctl_nam : Prints informations when an error occurs while reading a namelist 31 !! get_unit : give the index of an unused logical unit 31 32 !!---------------------------------------------------------------------- 32 33 #if defined key_mpp_mpi … … 61 62 IMPLICIT NONE 62 63 PRIVATE 63 64 PUBLIC ctl_stop, ctl_warn, get_unit, ctl_opn 64 65 PUBLIC ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam 65 66 PUBLIC mynode, mppstop, mppsync, mpp_comm_free 66 67 PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e … … 144 145 145 146 ! Type of send : standard, buffered, immediate 146 CHARACTER(len=1), PUBLIC :: cn_mpi_send = 'S'! type od mpi send/recieve (S=standard, B=bsend, I=isend)147 CHARACTER(len=1), PUBLIC :: cn_mpi_send ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 147 148 LOGICAL, PUBLIC :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I') 148 INTEGER, PUBLIC :: nn_buffer = 0! size of the buffer in case of mpi_bsend149 INTEGER, PUBLIC :: nn_buffer ! size of the buffer in case of mpi_bsend 149 150 150 151 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 225 226 226 227 227 FUNCTION mynode( ldtxt, kumnam , kstop, localComm )228 FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 228 229 !!---------------------------------------------------------------------- 229 230 !! *** routine mynode *** … … 232 233 !!---------------------------------------------------------------------- 233 234 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 234 INTEGER , INTENT(in ) :: kumnam ! namelist logical unit 235 INTEGER , INTENT(inout) :: kstop ! stop indicator 235 INTEGER , INTENT(in ) :: kumnam_ref ! logical unit for reference namelist 236 INTEGER , INTENT(in ) :: kumnam_cfg ! logical unit for configuration namelist 237 INTEGER , INTENT(in ) :: kumond ! logical unit for namelist output 238 INTEGER , INTENT(inout) :: kstop ! stop indicator 236 239 INTEGER, OPTIONAL , INTENT(in ) :: localComm 237 240 ! 238 INTEGER :: mynode, ierr, code, ji, ii 241 INTEGER :: mynode, ierr, code, ji, ii, ios 239 242 LOGICAL :: mpi_was_called 240 243 ! … … 247 250 WRITE(ldtxt(ii),*) '~~~~~~ ' ; ii = ii + 1 248 251 ! 249 jpni = -1; jpnj = -1; jpnij = -1 250 REWIND( kumnam ) ! Namelist namrun : parameters of the run 251 READ ( kumnam, nammpp ) 252 253 REWIND( kumnam_ref ) ! Namelist nammpp in reference namelist: mpi variables 254 READ ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901) 255 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 256 257 REWIND( kumnam_cfg ) ! Namelist nammpp in configuration namelist: mpi variables 258 READ ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 259 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 260 WRITE(kumond, nammpp) 261 252 262 ! ! control print 253 263 WRITE(ldtxt(ii),*) ' Namelist nammpp' ; ii = ii + 1 … … 3445 3455 3446 3456 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag 3447 LOGICAL, PUBLIC :: ln_nnogather = .FALSE.!: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)3457 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 3448 3458 INTEGER :: ncomm_ice 3449 3459 !!---------------------------------------------------------------------- … … 3455 3465 END FUNCTION lib_mpp_alloc 3456 3466 3457 FUNCTION mynode( ldtxt, kumnam , kstop, localComm ) RESULT (function_value)3467 FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg, kstop, localComm ) RESULT (function_value) 3458 3468 INTEGER, OPTIONAL , INTENT(in ) :: localComm 3459 3469 CHARACTER(len=*),DIMENSION(:) :: ldtxt 3460 INTEGER :: kumnam , kstop3470 INTEGER :: kumnam_ref, knumnam_cfg , kstop 3461 3471 IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) ) function_value = 0 3462 3472 IF( .FALSE. ) ldtxt(:) = 'never done' … … 3637 3647 3638 3648 !!---------------------------------------------------------------------- 3639 !! All cases: ctl_stop, ctl_warn, get_unit, ctl_opn routines3649 !! All cases: ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam routines 3640 3650 !!---------------------------------------------------------------------- 3641 3651 … … 3780 3790 END SUBROUTINE ctl_opn 3781 3791 3792 SUBROUTINE ctl_nam ( kios, cdnam, ldwp ) 3793 !!---------------------------------------------------------------------- 3794 !! *** ROUTINE ctl_nam *** 3795 !! 3796 !! ** Purpose : Informations when error while reading a namelist 3797 !! 3798 !! ** Method : Fortan open 3799 !!---------------------------------------------------------------------- 3800 INTEGER , INTENT(inout) :: kios ! IO status after reading the namelist 3801 CHARACTER(len=*) , INTENT(in ) :: cdnam ! group name of namelist for which error occurs 3802 CHARACTER(len=4) :: clios ! string to convert iostat in character for print 3803 LOGICAL , INTENT(in ) :: ldwp ! boolean term for print 3804 !!---------------------------------------------------------------------- 3805 3806 ! 3807 ! ---------------- 3808 WRITE (clios, '(I4.0)') kios 3809 IF( kios < 0 ) THEN 3810 CALL ctl_warn( 'W A R N I N G: end of record or file while reading namelist ' & 3811 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3812 ENDIF 3813 3814 IF( kios > 0 ) THEN 3815 CALL ctl_stop( 'E R R O R : misspelled variable in namelist ' & 3816 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3817 ENDIF 3818 kios = 0 3819 RETURN 3820 3821 END SUBROUTINE ctl_nam 3782 3822 3783 3823 INTEGER FUNCTION get_unit()
Note: See TracChangeset
for help on using the changeset viewer.
