Changeset 4147 for branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC
- Timestamp:
- 2013-11-04T12:51:55+01:00 (10 years ago)
- Location:
- branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
r3294 r4147 11 11 !! 3.2 ! 2009-07 (G. Madec) merge cla, cla_div, tra_cla, cla_dynspg 12 12 !! ! and correct a mpp bug reported by A.R. Porter 13 !!----------------------------------------------------------------------14 #if defined key_orca_r215 !!----------------------------------------------------------------------16 !! 'key_orca_r2' global ocean model R217 13 !!---------------------------------------------------------------------- 18 14 !! cla_div : update of horizontal divergence at cla straits … … 733 729 END SUBROUTINE cla_hormuz 734 730 735 #else736 !!----------------------------------------------------------------------737 !! Default key Dummy module738 !!----------------------------------------------------------------------739 USE lib_mpp, ONLY: ctl_stop740 CONTAINS741 SUBROUTINE cla_init742 CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' )743 END SUBROUTINE cla_init744 SUBROUTINE cla_div( kt )745 WRITE(*,*) 'cla_div: You should have not see this print! error?', kt746 END SUBROUTINE cla_div747 SUBROUTINE cla_traadv( kt )748 WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt749 END SUBROUTINE cla_traadv750 SUBROUTINE cla_dynspg( kt )751 WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt752 END SUBROUTINE cla_dynspg753 #endif754 755 731 !!====================================================================== 756 732 END MODULE cla -
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() -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r3818 r4147 45 45 INTEGER :: inum ! temporary logical unit 46 46 INTEGER :: idir ! temporary integers 47 INTEGER :: ios ! Local integer output status for namelist read 47 48 INTEGER :: & 48 49 ii, ij, ifreq, il1, il2, & ! temporary integers … … 77 78 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 78 79 !!---------------------------------------------------------------------- 79 80 REWIND ( numnam ) ! Read Namelist namzgr : vertical coordinate' 81 READ ( numnam, namzgr ) 80 81 REWIND( numnam_ref ) ! Namelist namzgr in reference namelist : Vertical coordinate 82 READ ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901) 83 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 84 85 REWIND( numnam_cfg ) ! Namelist namzgr in configuration namelist : Vertical coordinate 86 READ ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 87 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 88 WRITE ( numond, namzgr ) 82 89 83 90 IF(lwp)WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.