/[MITgcm]/MITgcm_contrib/ESMF/global_ocean.128x60x15/code/eeboot_minimal.F
ViewVC logotype

Contents of /MITgcm_contrib/ESMF/global_ocean.128x60x15/code/eeboot_minimal.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download)
Tue Mar 30 03:58:56 2004 UTC (21 years, 3 months ago) by cnh
Branch: MAIN
CVS Tags: adoption_1_0_pre_A, HEAD
New test with different size

1 C $Header: /u/gcmpack/MITgcm_contrib/ESMF/global_ocean.128x64x15/code/eeboot_minimal.F,v 1.3 2004/02/26 03:08:44 cnh Exp $
2 C $Name: $
3
4 #include "CPP_EEOPTIONS.h"
5
6 CBOP
7 C !ROUTINE: EEBOOT_MINIMAL
8
9 C !INTERFACE:
10 SUBROUTINE EEBOOT_MINIMAL
11 IMPLICIT NONE
12
13 C !DESCRIPTION:
14 C *==========================================================*
15 C | SUBROUTINE EEBOOT_MINIMAL
16 C | o Set an initial environment that is predictable i.e.
17 C | behaves in a similar way on all machines and stable.
18 C *==========================================================*
19 C | Under MPI this routine calls MPI_INIT to setup the
20 C | mpi environment ( on some systems the code is running as
21 C | a single process prior to MPI_INIT, on others the mpirun
22 C | script has already created multiple processes). Until
23 C | MPI_Init is called it is unclear what state the
24 C | application is in. Once this routine has been run it is
25 C | "safe" to do things like I/O to report erros and to get
26 C | run parameters.
27 C | Note: This routine can also be compiled with CPP
28 C | directives set so that no multi-processing is initialise.
29 C | This is OK and will work fine.
30 C *==========================================================*
31
32 C !USES:
33 C == Global data ==
34 #include "SIZE.h"
35 #include "EEPARAMS.h"
36 #include "EESUPPORT.h"
37
38 C !LOCAL VARIABLES:
39 C == Local variables ==
40 C myThid :: Temp. dummy thread number.
41 C fNam :: Used to build name of file for standard
42 C output and error output.
43 INTEGER myThid
44 CHARACTER*13 fNam
45 #ifdef ALLOW_USE_MPI
46 C mpiRC :: Error code reporting variable used
47 C with MPI.
48 C msgBuffer :: Used to build messages for printing.
49 CHARACTER*(MAX_LEN_MBUF) msgBuffer
50 INTEGER mpiRC
51 INTEGER nptmp
52 #endif /* ALLOW_USE_MPI */
53 CEOP
54
55 C-- Default values set to single processor case
56 numberOfProcs = 1
57 myProcId = 0
58 pidIO = myProcId
59 myProcessStr = '------'
60 C Set a dummy value for myThid because we are not multi-threading
61 C yet.
62 myThid = 1
63 #ifdef ALLOW_USE_MPI
64 C--
65 C-- MPI style multiple-process initialisation
66 C-- =========================================
67 #ifndef ALWAYS_USE_MPI
68 IF ( usingMPI ) THEN
69 #endif
70 C-- Initialise MPI multi-process parallel environment.
71 C On some systems program forks at this point. Others have already
72 C forked within mpirun - now thats an open standard!
73 C CALL MPI_INIT( mpiRC )
74 mpiRC = MPI_SUCCESS
75 IF ( mpiRC .NE. MPI_SUCCESS ) THEN
76 eeBootError = .TRUE.
77 WRITE(msgBuffer,'(A,I5)')
78 & 'S/R INI_PROCS: MPI_INIT return code',
79 & mpiRC
80 CALL PRINT_ERROR( msgBuffer , myThid)
81 GOTO 999
82 ENDIF
83
84 C-- MPI has now been initialized but now we need to either
85 C ask for a communicator or pretend that we have:
86 C Pretend that we have asked for a communicator
87 MPI_COMM_MODEL = MPI_COMM_WORLD
88 #ifdef COMPONENT_MODULE
89 C- jmc: test:
90 C add a 1rst preliminary call EESET_PARAMS to set useCoupler
91 C (needed to decide either to call CPL_INIT or not)
92 CALL EESET_PARMS
93 IF ( eeBootError ) GOTO 999
94 C- jmc: test end ; otherwise, uncomment next line:
95 useCoupler = .TRUE.
96 C-- Ask coupler interface for a communicator
97 IF ( useCoupler) CALL CPL_INIT
98 #endif
99
100 C-- Get my process number
101 CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC )
102 IF ( mpiRC .NE. MPI_SUCCESS ) THEN
103 eeBootError = .TRUE.
104 WRITE(msgBuffer,'(A,I5)')
105 & 'S/R INI_PROCS: MPI_COMM_RANK return code',
106 & mpiRC
107 CALL PRINT_ERROR( msgBuffer , myThid)
108 GOTO 999
109 ENDIF
110 myProcId = mpiMyId
111 WRITE(myProcessStr,'(I4.4)') myProcId
112 mpiPidIo = myProcId
113 pidIO = mpiPidIo
114 IF ( mpiPidIo .EQ. myProcId ) THEN
115 WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
116 OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
117 WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
118 OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
119 ENDIF
120
121 C-- Synchronise all processes
122 C Strictly this is superfluous, but by using it we can guarantee to
123 C find out about processes that did not start up.
124 CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
125 IF ( mpiRC .NE. MPI_SUCCESS ) THEN
126 eeBootError = .TRUE.
127 WRITE(msgBuffer,'(A,I5)')
128 & 'S/R INI_PROCS: MPI_BARRIER return code',
129 & mpiRC
130 CALL PRINT_ERROR( msgBuffer , myThid)
131 GOTO 999
132 ENDIF
133
134 C-- Get number of MPI processes
135 CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )
136 IF ( mpiRC .NE. MPI_SUCCESS ) THEN
137 eeBootError = .TRUE.
138 WRITE(msgBuffer,'(A,I5)')
139 & 'S/R INI_PROCS: MPI_COMM_SIZE return code',
140 & mpiRC
141 CALL PRINT_ERROR( msgBuffer , myThid)
142 GOTO 999
143 ENDIF
144 numberOfProcs = mpiNProcs
145
146 C-- Can not have more processes than compile time MAX_NO_PROCS
147 IF ( numberOfProcs .GT. MAX_NO_PROCS ) THEN
148 eeBootError = .TRUE.
149 WRITE(msgBuffer,'(A)')
150 & 'S/R INI_PROCS: No. of processes too large'
151 CALL PRINT_ERROR( msgBuffer , myThid)
152 GOTO 999
153 ENDIF
154 C-- Under MPI only allow same number of processes as proc.
155 C-- grid size.
156 C Strictly we are allowed more procs. but knowing there
157 C is an exact match makes things easier.
158 IF ( numberOfProcs .NE. nPx*nPy ) THEN
159 eeBootError = .TRUE.
160 nptmp = nPx*nPy
161 WRITE(msgBuffer,'(A,2I5)')
162 & 'S/R INI_PROCS: No. of processes not equal to nPx*nPy',
163 & numberOfProcs, nptmp
164 CALL PRINT_ERROR( msgBuffer , myThid)
165 GOTO 999
166 ENDIF
167
168 #ifndef ALWAYS_USE_MPI
169 ENDIF
170 #endif
171
172 #else /* ALLOW_USE_MPI */
173
174 WRITE(myProcessStr,'(I4.4)') myProcId
175 WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
176 OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
177 c WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
178 c OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
179
180 #endif /* ALLOW_USE_MPI */
181
182 999 CONTINUE
183
184 RETURN
185 END
186

  ViewVC Help
Powered by ViewVC 1.1.22