source: CPL/oasis3/trunk/src/mod/oasis3/src/waitpc.F @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 6.1 KB
Line 
1      SUBROUTINE waitpc
2C****
3C               *****************************
4C               * OASIS ROUTINE  -  LEVEL C *
5C               * -------------     ------- *
6C               *****************************
7C
8C**** *waitpc*  - Insure proper termination of simulation
9C
10C     Purpose:
11C     -------
12C     Wait for gcm's termination so that child processes end up
13C     before their parent.
14C     Use system call wait to pause calling process until
15C     completion of child processes.
16C
17C**   Interface:
18C     ---------
19C       *CALL*  *waitpc*
20C
21C     Input:
22C     -----
23C     None
24C
25C     Output:
26C     ------
27C     None
28C
29C     Workspace:
30C     ---------
31C     None
32C
33C     Externals:
34C     ---------
35C     wait, waitcld, SIPC_End, CLIM_Quit
36C
37C     Reference:
38C     ---------
39C     See OASIS manual (1997)
40C
41C     History:
42C     -------
43C       Version   Programmer     Date      Description
44C       -------   ----------     ----      ----------- 
45C       1.0       L. Terray      94/01/01  created
46C       2.0       L. Terray      95/09/01  modified: new structure
47C       2.2       S. Valcke      97/09/03  added: introduction of SVIPC
48C       2.2       L. Terray      97/12/24  added: change waitsipc routine
49C       2.3       S. Valcke      99/04/30  added: printing levels
50C       2.3       L. Terray      99/09/15  added: GMEM branch. replace
51C                                                 SIPC_Destroy by SIPC_End
52C       2.5       S. Valcke      2K/09/04  Remove cmach
53C
54C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
55C
56C* ---------------- Include files and USE of modules---------------------------
57C
58      USE mod_kinds_oasis
59#if defined use_comm_MPI1 || defined use_comm_MPI2 || !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
60      USE mod_clim
61#endif
62      USE mod_parameter
63      USE mod_sipc
64      USE mod_experiment
65      USE mod_pipe
66      USE mod_nproc
67      USE mod_unit
68      USE mod_hardware
69      USE mod_printing
70C
71C* ---------------------------- Local declarations ----------------------
72C
73      INTEGER (kind=ip_intwp_p) wait
74      INTEGER (kind=ip_intwp_p) iwone
75C
76C* ---------------------------- Poema verses ----------------------------
77C
78C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79C
80C*    1. Initialization
81C        --------------
82C
83      IF (nlogprt .GE. 2) THEN
84          WRITE (UNIT = nulou,FMT = *) ' '
85          WRITE (UNIT = nulou,FMT = *) ' '
86          WRITE (UNIT = nulou,FMT = *)
87     $    '           ROUTINE waitpc  -  Level C'
88          WRITE (UNIT = nulou,FMT = *)
89     $    '           **************     *******'
90          WRITE (UNIT = nulou,FMT = *) ' '
91          WRITE (UNIT = nulou,FMT = *) ' Wait until gcm completion '
92          WRITE (UNIT = nulou,FMT = *) ' Exit if interpolator only '
93          WRITE (UNIT = nulou,FMT = *) ' '
94      ENDIF
95C
96C
97C*    2. Wait until gcm's completion 
98C        ---------------------------
99C
100      iwone = 0
101      IF (cchan .EQ. 'PIPE' .OR. cchan .EQ. 'SIPC'
102     $    .OR. cchan .EQ. 'GMEM') THEN
103          DO 210 jm = 1, ig_nmodel
104#ifdef use_comm_PIPE           
105            iwone = wait(isone)
106#elif defined use_comm_SIPC || defined use_comm_GMEM   
107            CALL waitcld(isone,iwone)
108#endif
109            IF (iwone .eq. -1) THEN
110                WRITE (UNIT = nulou,FMT = *) '        ***WARNING***'
111                WRITE (UNIT = nulou,FMT = *) 
112     $              ' ===>>> Model numbered = ', jm
113                WRITE (UNIT = nulou,FMT = *) 
114     $              ' ======         ====        ====     '
115                WRITE (UNIT = nulou,FMT = *) 
116     $          ' was not an running child when waitpc was called '
117                CALL FLUSH(nulou)
118            ELSE
119                DO 220 jk = 1, ig_nmodel
120                  IF (iwone .EQ. nproc(jk)) THEN
121                      IF (nlogprt .GE. 1) THEN
122                          CALL prcout
123     $                    ('End of simulation for model named', 
124     $                     cmodnam(jk), 1)
125                          CALL prtout
126     $                    ('Exit of process nproc =', nproc(jk), 1)
127                          WRITE (UNIT = nulou,FMT = *) 
128     $                    ' coupler waits until end of other gcms '
129                      ENDIF
130                      GO TO 210
131                  ENDIF
132 220            CONTINUE
133                WRITE (UNIT = nulou,FMT = *) '        ***WARNING***'
134                WRITE (UNIT = nulou,FMT = *) 
135     $              ' ===>>> : first wait return code is = '
136     $              ,iwone
137                WRITE (UNIT = nulou,FMT = *) 
138     $              ' ======         ====        ====      '
139                WRITE (UNIT = nulou,FMT = *) ' '
140                WRITE (UNIT = nulou,FMT = *) 
141     $              ' Either gcm is probably multitasked '
142                WRITE (UNIT = nulou,FMT = *) 
143     $              ' The leaving process with pid = ', iwone
144                WRITE (UNIT = nulou,FMT = *) 
145     $              ' is different from the initial process values  '
146                WRITE (UNIT = nulou,FMT = *) 
147     $              ' We go on til normal termination !!!'
148             ENDIF
149 210      CONTINUE
150C
151C* Destroy shared-memory pools used for exchanging fields and
152C  pool for reading/writing initial infos from/to models
153C
154#if defined use_comm_SIPC || use_comm_GMEM
155          CALL SIPC_End(ig_nmodel)
156#endif
157C
158       ENDIF
159#if defined use_comm_MPI1 || defined use_comm_MPI2 || !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
160       CALL CLIM_Quit( infos)
161       IF (infos .NE. CLIM_Ok) THEN
162          CALL prtout
163     $         ('An error occured while leaving CLIM. Error =',
164     $         infos, 2)
165       ENDIF
166#endif
167C
168C
169C
170C*    3. End of program
171C        --------------
172C
173      IF (nlogprt .GE. 2) THEN
174          WRITE (UNIT = nulou,FMT = *) ' '
175          WRITE (UNIT = nulou,FMT = *) 
176     $    '          --------- End of routine waitpc ---------'
177          CALL FLUSH (nulou)
178      ENDIF
179      RETURN
180      END
181
Note: See TracBrowser for help on using the repository browser.