eesupp/src/eeset_parms.F

924557e60a Chri*0001 #include "CPP_EEOPTIONS.h"
                0002
4c563c2ee9 Chri*0003 CBOP
8ad19e1d95 Jean*0004 C     !ROUTINE: EESET_PARMS
4c563c2ee9 Chri*0005
                0006 C     !INTERFACE:
6b551785d1 Jean*0007       SUBROUTINE EESET_PARMS( procId, doReport )
924557e60a Chri*0008
4c563c2ee9 Chri*0009 C     !DESCRIPTION:
                0010 C     *==========================================================*
8ad19e1d95 Jean*0011 C     | SUBROUTINE EESET\_PARMS
                0012 C     | o Routine to set model "parameters"
4c563c2ee9 Chri*0013 C     *==========================================================*
8ad19e1d95 Jean*0014 C     | This routine is called from the high-level wrapper
                0015 C     | after multi-process paralle processing has started but
                0016 C     | before multi-threaded parallelism. THe routine reads an
                0017 C     | an "execution environment" input parameter file holding
                0018 C     | information about the number of threads at run-time.
4c563c2ee9 Chri*0019 C     *==========================================================*
                0020
                0021 C     !USES:
731627cf5e Jean*0022       IMPLICIT NONE
                0023
4c563c2ee9 Chri*0024 C     == Global variables ==
924557e60a Chri*0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "EESUPPORT.h"
c11f817917 Jean*0028 #include "EXCH.h"
5d5e83c00e Jean*0029
                0030 C     !INPUT PARAMETERS:
3777bbd57d Jean*0031 C     procId   :: this process id. number (either in World or in Model)
5d5e83c00e Jean*0032 C     doReport :: if false, skip error stop and any report to std-out/err
3777bbd57d Jean*0033       INTEGER  procId
5d5e83c00e Jean*0034       LOGICAL  doReport
                0035
                0036 C     !FUNCTIONS:
4c563c2ee9 Chri*0037       INTEGER  IFNBLNK
                0038       EXTERNAL IFNBLNK
                0039       INTEGER  ILNBLNK
                0040       EXTERNAL ILNBLNK
924557e60a Chri*0041
4c563c2ee9 Chri*0042 C     !LOCAL VARIABLES:
                0043 C     == Local variables ==
                0044 C     iUnit  :: Work variable for IO unit number
                0045 C     errIO  :: IO unit error flag
                0046 C     IL     :: Temp. for index strings
                0047 C     msgBuf :: Temp. for textual I/O
                0048 C     record :: Temp. for textual I/O
76c208745c Alis*0049       INTEGER IL
924557e60a Chri*0050       INTEGER errIO
                0051       INTEGER iUnit
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053       CHARACTER*(MAX_LEN_PREC) record
133c6caa8d Mart*0054 # if !defined(USE_FORTRAN_SCRATCH_FILES) || defined(SINGLE_DISK_IO)
b5912aa7d7 Jean*0055       CHARACTER*(MAX_LEN_FNAM) scratchFile1
90807ba1b6 Jean*0056 #endif
                0057 #ifdef SINGLE_DISK_IO
eb083ce29c Dimi*0058 C     mpiRC  :: Error code reporting variable used with MPI.
                0059       INTEGER mpiRC
b5912aa7d7 Jean*0060 #endif
c3d0b098ae Lars*0061 #ifdef USE_PDAF
                0062       INTEGER mpi_task_id
                0063 #endif
b5912aa7d7 Jean*0064 CEOP
                0065
924557e60a Chri*0066       NAMELIST /EEPARMS/
0deb8b4619 Jean*0067      & nTx, nTy, usingMPI,
                0068      & useCubedSphereExchange,
6591b3fcc3 Jean*0069      & useCoupler, useNEST_PARENT, useNEST_CHILD,
                0070      & useNest2W_parent, useNest2W_child, useOASIS,
8ad19e1d95 Jean*0071      & useSETRLSTK, useSIGREG,
731627cf5e Jean*0072      & debugMode, printMapIncludesZeros, maxLengthPrt1D
924557e60a Chri*0073
c11f817917 Jean*0074 C--   For now these options are fixed as the code does not fully support
                0075 C     features for overlapping communication and computation.
924557e60a Chri*0076       usingSyncMessages          = .TRUE.
910f05e765 Chri*0077
c11f817917 Jean*0078 C--   The remaining parameters here are set to default values; and then
                0079 C--   any different values are read from an input file called "eedata".
924557e60a Chri*0080 C     The defaults set here are for serial execution.
                0081 C
c11f817917 Jean*0082 C     nTx and nTy are the number of threads in the X and Y directions.
924557e60a Chri*0083 C     nSx/nTx and nSy/nTy be whole numbers at present.
                0084 C
c11f817917 Jean*0085 C     notUsingXPeriodicity and notUsingYPeriodicity affect the identifying
                0086 C     of neighbor processes in a multi-process mode.
                0087 C     On the whole the numerical model code should not customise itself based
                0088 C     on these numbers as they may be removed if they do not prove useful.
924557e60a Chri*0089 C
c11f817917 Jean*0090 C     usingMPI is a flag which controls whether MPI message passing library
                0091 C     calls are actually made. Note that under MPI it is necessary to start
                0092 C     a program a special way - normally using a command of the form
924557e60a Chri*0093 C     % mpirun program_name
c11f817917 Jean*0094 C     If usingMPI is set to TRUE but % mpirun .... was not used to launch
                0095 C     the program then an internal MPI error may be generated when the first
                0096 C     MPI call ( CALL MPI_Init ) is made.
924557e60a Chri*0097 C
ed584e7d0c Jean*0098 C     useCoupler is a flag which controls communications with other
                0099 C     model components through a coupler interface.
                0100 C
8ad19e1d95 Jean*0101 C     useSETRLSTK is a flag which toggles calling a small C routine
df91541502 Ed H*0102 C     which sets the stack size to "unlimited" using setrlimit()
ab504a3a96 Ed H*0103
924557e60a Chri*0104       notUsingXPeriodicity       = .FALSE.
                0105       notUsingYPeriodicity       = .FALSE.
aea29c8517 Alis*0106       useCubedSphereExchange     = .FALSE.
5d5e83c00e Jean*0107 #ifdef ALLOW_USE_MPI
                0108       usingMPI                   = .TRUE.
                0109 #else
924557e60a Chri*0110       usingMPI                   = .FALSE.
5d5e83c00e Jean*0111 #endif
ed584e7d0c Jean*0112       useCoupler                 = .FALSE.
0deb8b4619 Jean*0113       useNEST_PARENT             = .FALSE.
                0114       useNEST_CHILD              = .FALSE.
6591b3fcc3 Jean*0115       useNest2W_parent           = .FALSE.
                0116       useNest2W_child            = .FALSE.
9aa451bbe6 Mart*0117       useOASIS                   = .FALSE.
65d079bafa Alis*0118       nTx                        = 1
                0119       nTy                        = 1
df91541502 Ed H*0120       useSETRLSTK                = .FALSE.
b81731e160 Ed H*0121       useSIGREG                  = .FALSE.
924557e60a Chri*0122
8ad19e1d95 Jean*0123 C--   Parameter for printing (ascii) to Std-Oupt:
731627cf5e Jean*0124 C     Print debug msg (sequence of S/R calls)
                0125       debugMode = .FALSE.
8ad19e1d95 Jean*0126 C     Text map plots of fields ignore exact zero values
                0127       printMapIncludesZeros = .FALSE.
                0128 C     Maximum length for printing (to Std-Msg-Unit) 1-D array
                0129       maxLengthPrt1D = 65
                0130
3ee5154f7c Jean*0131 C     To write output to global-files and from Master MPI process only
                0132 C     NOTE: read from main parameter file "data"
                0133       useSingleCpuIO = .FALSE.
                0134
924557e60a Chri*0135 C--   Read in data from eedata file
                0136
6b551785d1 Jean*0137 C     Make a scratch copy of input eedata file without comments
eb083ce29c Dimi*0138 #ifdef SINGLE_DISK_IO
e018783d3d Jean*0139 C     Stop if called from eeboot_minimal.F before myProcId is set
06c7c05b27 Dimi*0140       IF ( .NOT.doReport )
e018783d3d Jean*0141      &     STOP 'ABNORMAL END: S/R EESET_PARMS: myProcId unset'
8336c6aa6d Dimi*0142       WRITE(scratchFile1,'(A)') 'scratch1'
e018783d3d Jean*0143       IF( myProcId .EQ. 0 ) THEN
6b551785d1 Jean*0144        OPEN( UNIT=scrUnit1, FILE=scratchFile1, STATUS='UNKNOWN' )
eb083ce29c Dimi*0145       ENDIF
                0146 #else /* ifndef SINGLE_DISK_IO */
d459aedd7a Mart*0147 # ifdef USE_FORTRAN_SCRATCH_FILES
                0148 C     this is the old default, which can cause filename conflicts on some
                0149 C     multi-node/multi-processor systems
6b551785d1 Jean*0150       OPEN( UNIT=scrUnit1, STATUS='SCRATCH' )
d459aedd7a Mart*0151 # else
                0152 C     this definition will go into CPP_EEMACROS.h, once this method is
                0153 C     properly established
                0154 C     After opening regular files here, they are closed with STATUS='DELETE'
c3d0b098ae Lars*0155 #ifdef USE_PDAF
                0156       CALL GET_TASKID_PDAF(mpi_task_id)
                0157       WRITE(scratchFile1,'(A,'//FMT_PROC_ID//',A,'//FMT_TSK_ID//')')
                0158      &     'scratch1.', procId, '.', mpi_task_id
                0159 #else
133c6caa8d Mart*0160       WRITE(scratchFile1,'(A,'//FMT_PROC_ID//')') 'scratch1.', procId
c3d0b098ae Lars*0161 #endif
6b551785d1 Jean*0162       OPEN( UNIT=scrUnit1, FILE=scratchFile1, STATUS='UNKNOWN' )
eb083ce29c Dimi*0163 # endif
                0164 #endif /* SINGLE_DISK_IO */
                0165
                0166 #ifdef SINGLE_DISK_IO
e018783d3d Jean*0167       IF( myProcId .EQ. 0 ) THEN
1dfb26592e Cons*0168 #endif
eb083ce29c Dimi*0169
6b551785d1 Jean*0170 C--   Open the parameter file eedata
                0171       OPEN( UNIT=eeDataUnit, FILE='eedata', STATUS='OLD',
                0172      &      err=1, IOSTAT=errIO )
924557e60a Chri*0173       IF ( errIO .GE. 0 ) GOTO 2
                0174     1 CONTINUE
5d5e83c00e Jean*0175       IF ( doReport ) THEN
                0176         WRITE(msgBuf,'(2A)') 'EESET_PARMS: ',
                0177      &       'Unable to open parameter file "eedata"'
                0178         CALL PRINT_ERROR( msgBuf, 1 )
                0179         CALL EEDATA_EXAMPLE
86e28207df Jean*0180 C note: At this early stage, MPI might not be yet fully set-up; for this reason
                0181 C       set error flag and return (to avoid a call to ALL_PROC_DIE before stop)
                0182 c       STOP 'ABNORMAL END: S/R EESET_PARMS'
                0183         eeBootError = .TRUE.
5d5e83c00e Jean*0184       ELSE
                0185         RETURN
                0186       ENDIF
924557e60a Chri*0187     2 CONTINUE
5d5e83c00e Jean*0188
6b551785d1 Jean*0189 C--   Read parameter eedata file, make a scratch copy without comments
                0190 C     and report contents of parameter file to STDOUT
5d5e83c00e Jean*0191       IF ( doReport ) THEN
                0192        WRITE(msgBuf,'(A)')
46dc4f419b Chri*0193      & '// ======================================================='
5d5e83c00e Jean*0194        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1)
                0195        WRITE(msgBuf,'(A)')
46dc4f419b Chri*0196      & '// Execution Environment parameter file "eedata"'
5d5e83c00e Jean*0197        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1)
                0198        WRITE(msgBuf,'(A)')
46dc4f419b Chri*0199      & '// ======================================================='
5d5e83c00e Jean*0200        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1)
6b551785d1 Jean*0201       ENDIF
924557e60a Chri*0202
6b551785d1 Jean*0203 C     Read file, remove comments and apply specific syntax changes:
                0204  1000 CONTINUE
                0205        READ(eeDataUnit,FMT='(A)',END=1001) RECORD
                0206        IL = MAX(ILNBLNK(RECORD),1)
                0207        IF ( RECORD(1:1) .NE. commentCharacter ) THEN
                0208          CALL NML_SET_TERMINATOR( RECORD )
                0209          WRITE(UNIT=scrUnit1,FMT='(A)') RECORD(:IL)
                0210        ENDIF
                0211        IF ( doReport ) THEN
5d5e83c00e Jean*0212         WRITE(msgBuf,'(A,A)') '>',RECORD(:IL)
6b551785d1 Jean*0213         CALL PRINT_MESSAGE( msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1 )
                0214        ENDIF
                0215        GOTO 1000
                0216  1001 CONTINUE
                0217       CLOSE(eeDataUnit)
                0218       IF ( doReport ) THEN
5d5e83c00e Jean*0219        WRITE(msgBuf,'(A)') ' '
                0220        CALL PRINT_MESSAGE(msgBuf,standardMessageUnit, SQUEEZE_RIGHT, 1)
                0221       ENDIF
924557e60a Chri*0222
eb083ce29c Dimi*0223 #ifdef SINGLE_DISK_IO
06c7c05b27 Dimi*0224       CALL FLUSH(scrUnit1)
8336c6aa6d Dimi*0225       CLOSE(scrUnit1)
eb083ce29c Dimi*0226       ENDIF
                0227 # ifdef ALLOW_USE_MPI
8336c6aa6d Dimi*0228 C--   all processes must wait for process 0 to complete
                0229 C     writing scratchFile1 before opening it
90807ba1b6 Jean*0230       IF ( usingMPI ) THEN
                0231         CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
                0232       ENDIF
eb083ce29c Dimi*0233 # endif
daa19abb49 Jean*0234 #ifdef HAVE_SYSTEM
06c7c05b27 Dimi*0235       CALL SYSTEM('sleep 1')
daa19abb49 Jean*0236 #endif
6b551785d1 Jean*0237       OPEN( UNIT=scrUnit1, FILE=scratchFile1, STATUS='OLD' )
eb083ce29c Dimi*0238 #endif /* SINGLE_DISK_IO */
                0239
8336c6aa6d Dimi*0240 C--   Read namelist
                0241       iUnit = scrUnit1
                0242       REWIND(iUnit)
924557e60a Chri*0243       READ(UNIT=iUnit,NML=EEPARMS,IOSTAT=errIO,err=3)
                0244       IF ( errIO .GE. 0 ) GOTO 4
                0245     3 CONTINUE
2c24d43b0c Dani*0246 #ifndef TARGET_PWR3
5d5e83c00e Jean*0247       IF ( doReport ) THEN
                0248        WRITE(msgBuf,'(2A)') 'EESET_PARMS: ',
                0249      &      'Error reading parameter file "eedata"'
                0250        CALL PRINT_ERROR( msgBuf, 1 )
924557e60a Chri*0251        CALL EEDATA_EXAMPLE
86e28207df Jean*0252        eeBootError = .TRUE.
5d5e83c00e Jean*0253       ENDIF
2c24d43b0c Dani*0254 #endif
924557e60a Chri*0255    4  CONTINUE
                0256
b51e35105b Chri*0257 C--   Execution Environment parameter file read
54c2b49af5 Mart*0258 #ifdef SINGLE_DISK_IO
89bcd05385 Mart*0259       CLOSE(iUnit)
54c2b49af5 Mart*0260 #else
0628219f77 Mart*0261       CLOSE(iUnit,STATUS='DELETE')
54c2b49af5 Mart*0262 #endif /* SINGLE_DISK_IO */
b51e35105b Chri*0263
5d5e83c00e Jean*0264 #ifdef ALLOW_USE_MPI
                0265 #ifdef ALWAYS_USE_MPI
                0266       IF ( doReport .AND. .NOT.usingMPI ) THEN
                0267        WRITE(msgBuf,'(2A)') 'EESET_PARMS: ',
                0268      &                      'in eedata: usingMPI=F conflicts'
                0269        CALL PRINT_ERROR( msgBuf, 1 )
                0270        WRITE(msgBuf,'(A)') 'EESET_PARMS:  with #define ALWAYS_USE_MPI'
                0271        CALL PRINT_ERROR( msgBuf, 1 )
86e28207df Jean*0272        eeBootError = .TRUE.
5d5e83c00e Jean*0273       ENDIF
                0274       usingMPI = .TRUE.
                0275 #endif
02efaefb87 Jean*0276 #else /* ALLOW_USE_MPI */
                0277       IF ( doReport .AND. usingMPI ) THEN
                0278        WRITE(msgBuf,'(2A)') 'EESET_PARMS: ',
                0279      &                      'in eedata: usingMPI=T conflicts'
                0280        CALL PRINT_ERROR( msgBuf, 1 )
                0281        WRITE(msgBuf,'(A)') 'EESET_PARMS:  with #undef ALLOW_USE_MPI'
                0282        CALL PRINT_ERROR( msgBuf, 1 )
86e28207df Jean*0283        eeBootError = .TRUE.
02efaefb87 Jean*0284       ENDIF
                0285       usingMPI = .FALSE.
                0286 #endif /* ALLOW_USE_MPI */
5d5e83c00e Jean*0287
924557e60a Chri*0288 Cdbg  eeDataUnit = 42
                0289 Cdbg  OPEN(UNIT=eeDataUnit,FILE='eedata',STATUS='OLD',IOSTAT=errIO)
                0290 Cdbg  IF ( errIO .LT. 0 ) GOTO 11
                0291 Cdbg  DO K=1, 10
                0292 Cdbg   READ(eedataUnit,IOSTAT=errIO)
                0293 Cdbg   IF ( errIO .LT. 0 ) GOTO 11
8ad19e1d95 Jean*0294 Cdbg  ENDDO
924557e60a Chri*0295 Cdbg  READ(eedataUnit,FMT='(30X,1X,L23)',IOSTAT=errIO) notUsingXPeriodicity
                0296 Cdbg  IF ( errIO .LT. 0 ) GOTO 11
                0297 Cdbg  READ(eedataUnit,FMT='(30X,1X,L23)',IOSTAT=errIO) notUsingYPeriodicity
                0298 Cdbg  IF ( errIO .LT. 0 ) GOTO 11
                0299 Cdbg  READ(eedataUnit,FMT='(30X,1X,L23)',IOSTAT=errIO) usingMPI
                0300 Cdbg  IF ( errIO .LT. 0 ) GOTO 11
8ad19e1d95 Jean*0301 Cdbg  READ(eedataUnit,FMT='(30X,1X,I3)',IOSTAT=errIO) nTx
924557e60a Chri*0302 Cdbg  IF ( errIO .LT. 0 ) GOTO 11
8ad19e1d95 Jean*0303 Cdbg  READ(eedataUnit,FMT='(30X,1X,I3)',IOSTAT=errIO) nTy
924557e60a Chri*0304
                0305 Cdbg  IF (errIO .LT. 0 ) eeBootError = .TRUE.
                0306 Cdbg  CLOSE(eeDataUnit,IOSTAT=errIO)
                0307 Cdbg  IF ( eeBootError .OR. errIO .LT. 0 ) THEN
                0308 C--    Report that an error occured
                0309 Cdbg   eeBootError = .TRUE.
8ad19e1d95 Jean*0310 Cdbg   WRITE(msgBuf,'(A)' )
924557e60a Chri*0311 Cdbg &  'S/R EESET_PARMS: Error reading "eedata" execution environment file'
                0312 Cdbg   CALL PRINT_ERROR( msgBuf , 1)
                0313 Cdbg  ELSE
                0314 C--    Write summary of settings that were selected
                0315 Cdbg  ENDIF
5d5e83c00e Jean*0316
c11f817917 Jean*0317       IF ( doReport ) THEN
                0318 C--   Set parameters for EXCH communication routines
                0319 C     Note: only done once when called with doReport=T
                0320
                0321         exchCollectStatistics = .TRUE.
                0322 C--   Turn off memsync by default (e.g. needed for threads on SUNs)
                0323         exchNeedsMemsync = .TRUE.
                0324         exchUsesBarrier  = .TRUE.
                0325         IF ( usingMPI ) THEN
                0326 C--   ... except that MPI needs this until some counter problem is fixed.
                0327           exchNeedsMemsync = .FALSE.
                0328           exchUsesBarrier  = .FALSE.
                0329         ENDIF
                0330
                0331 C--   End setting parameters for EXCH communication routines
                0332       ENDIF
                0333
924557e60a Chri*0334       RETURN
                0335       END