source: CPL/oasis3/trunk/src/lib/psmile/src/prism_terminate_proto.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: 10.7 KB
Line 
1      SUBROUTINE prism_terminate_proto(kinfo)
2c
3c*    *** PRISM_Terminate ***   PRISM 1.0
4c
5c     purpose:
6c     --------
7c        leave mpi
8c
9c     interface:
10c     ----------
11c        kinfo  : output status
12c
13c     lib mp:
14c     -------
15c        MPI-1 or MPI-2
16c
17c     author:
18c     -------
19c         Arnaud Caubel  - Fecit (08/02 - created from CLIM_Quit)
20c         S. Legutke     - MPI M&D, MPI_Finalize info added
21c     ----------------------------------------------------------------
22      USE mod_kinds_model     
23      USE mod_prism_proto
24      USE mod_comprism_proto
25#if !defined key_noIO
26      USE mod_psmile_io_interfaces
27#endif
28#include <mpif.h>
29c     ----------------------------------------------------------------
30      INTEGER (kind=ip_intwp_p) kinfo
31c     ----------------------------------------------------------------
32      INTEGER (kind=ip_intwp_p) info, il_rank, ji, il_start
33c     ----------------------------------------------------------------
34      INTEGER (kind=ip_intwp_p)       il_bufsizebyt
35      REAL(kind=ip_double_p)  dl_bufaddr
36c
37c*    0. First Check
38c     --------------
39c
40      IF (nexit.ne.1) THEN
41          kinfo = CLIM_FastExit
42          WRITE(nulprt,FMT='(A)') 'Terminate - should not be called'
43          GO TO 1010
44      ENDIF
45      WRITE(nulprt,*)'entering PRISM_terminate'
46      kinfo = CLIM_Ok
47c
48      CALL MPI_Comm_Rank(mpi_comm,il_rank,mpi_err)
49c
50      DEALLOCATE(kbtotproc)
51      DEALLOCATE(kbcplproc)
52      DEALLOCATE(iga_unitmod)
53      DEALLOCATE(cg_modnam)
54      DEALLOCATE(cunames)
55c
56      IF (lg_oasis_field) THEN
57         il_start = 0
58      ELSE
59         il_start = 1
60      ENDIF
61      DO ji = il_start, ncplprocs-1 
62        IF (il_rank.eq.modtid(ji)) THEN
63#if !defined key_noIO
64           call psmile_close_files(il_err)
65           call psmile_io_cleanup(il_err)
66#endif
67            DEALLOCATE (ncode, stat=il_err)
68            IF (il_ERR.ne.0) WRITE(nulprt,*)
69     $      'Error in ncode deallocation in prism_terminate'
70            DEALLOCATE (delta, stat=il_err)
71            IF (il_ERR.ne.0) WRITE(nulprt,*)
72     $          'Error in delta deallocation in prism_terminate'
73            DEALLOCATE (delte, stat=il_err)
74            IF (il_ERR.ne.0) WRITE(nulprt,*)
75     $          'Error in delte deallocation in prism_terminate'
76            DEALLOCATE (cnames, stat=il_err)
77            IF (il_ERR.ne.0) WRITE(nulprt,*)
78     $          'Error in cnames deallocation in prism_terminate'
79            DEALLOCATE (myport, stat = il_ERR)
80            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
81     $          ' Problem in "myport" deallocation in prism_terminate'
82            DEALLOCATE (mydist,stat = il_ERR)
83            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
84     $          ' Problem in "mydist" deallocation in prism_terminate'
85            DEALLOCATE (cports, stat = il_ERR)
86            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
87     $          ' Problem in "cports" deallocation in prism_terminate'
88            DEALLOCATE(clrport, stat = il_ERR)
89            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
90     $          'Error in clrport deallocation in prism_terminate'
91            DEALLOCATE(irdist, stat = il_ERR)
92            IF (il_ERR.ne.0) WRITE(nulprt,*)
93     $          'Error in irdist deallocation in PRISM_terminate'
94            DEALLOCATE(irport, stat = il_ERR)
95            IF (il_ERR.ne.0) WRITE(nulprt,*)
96     $          'Error in irport deallocation in PRISM_terminate'
97            DEALLOCATE (mylink, stat = il_ERR)
98            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
99     $          ' Problem in "mylink" deallocation in prism_terminate'
100            DEALLOCATE (pkwork, stat = il_ERR)
101            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
102     $          ' Problem in "pkwork" deallocation in prism_terminate'
103            DEALLOCATE (ig_def_part, stat = il_ERR)
104            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
105     $      ' Problem in "ig_def_part" deallocation in prism_terminate'
106            DEALLOCATE (ig_length_part, stat = il_ERR)
107            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
108     $   ' Problem in "ig_length_part" deallocation in prism_terminate'
109            DEALLOCATE (pkwork_field, stat = il_ERR)
110            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
111     $    ' Problem in "pkwork_field" deallocation in prism_terminate'
112            DEALLOCATE (cg_cnaminp, stat = il_ERR)
113            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
114     $      ' Problem in "cg_cnaminp" deallocation in prism_terminate'
115            DEALLOCATE (cg_cnamout, stat = il_ERR)
116            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
117     $       ' Problem in "cg_cnamout" deallocation in prism_terminate'
118            DEALLOCATE (ig_clim_lag, stat = il_ERR)
119            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
120     $      ' Problem in "ig_clim_lag" deallocation in prism_terminate'
121            DEALLOCATE (ig_clim_reverse, stat = il_ERR)
122            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
123     $      ' Problem ig_clim_reverse deallocation in prism_terminate'
124            DEALLOCATE (ig_clim_invert, stat = il_ERR)
125            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
126     $      ' Problem ig_clim_invert deallocation in prism_terminate'
127            DEALLOCATE (ig_def_lag, stat = il_ERR)
128            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
129     $       ' Problem in "ig_def_lag" deallocation in prism_terminate'
130            DEALLOCATE (ig_def_reverse, stat = il_ERR)
131            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
132     $       ' Problem ig_def_reverse deallocation in prism_terminate'
133            DEALLOCATE (ig_def_invert, stat = il_ERR)
134            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
135     $       ' Problem ig_def_invert deallocation in prism_terminate'
136            DEALLOCATE (ig_clim_freq, stat = il_ERR)
137            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
138     $     ' Problem in "ig_clim_freq" deallocation in prism_terminate'
139            DEALLOCATE (ig_def_freq, stat = il_ERR)
140            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
141     $      ' Problem in "ig_def_freq" deallocation in prism_terminate'
142            DEALLOCATE (ig_clim_seq, stat = il_ERR)
143            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
144     $      ' Problem in "ig_clim_seq" deallocation in prism_terminate'
145            DEALLOCATE (ig_def_seq, stat = il_ERR)
146            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
147     $      ' Problem in "ig_def_seq" deallocation in prism_terminate'
148            DEALLOCATE (cg_clim_rstfile, stat = il_ERR)
149            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
150     $  ' Problem in "cg_clim_rstfile" deallocation in prism_terminate'
151            DEALLOCATE (cg_def_rstfile, stat = il_ERR)
152            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
153     $   ' Problem in "cg_def_rstfile" deallocation in prism_terminate'
154            DEALLOCATE (ig_clim_norstfile, stat = il_ERR)
155            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
156     $' Problem in "ig_clim_norstfile" deallocation in prism_terminate'
157            DEALLOCATE (ig_def_norstfile, stat = il_ERR)
158            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
159     $' Problem in "ig_def_norstfile" deallocation in prism_terminate'
160            DEALLOCATE (ig_clim_state, stat = il_ERR)
161            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
162     $    ' Problem in "ig_clim_state" deallocation in prism_terminate'
163            DEALLOCATE (ig_def_state, stat = il_ERR)
164            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
165     $    ' Problem in "ig_def_state" deallocation in prism_terminate'
166             DEALLOCATE (ig_clim_trans, stat = il_ERR)
167            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
168     $   ' Problem in "ig_clim_trans" deallocation in prism_terminate'
169             DEALLOCATE (ig_clim_numlab, stat = il_ERR)
170            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
171     $   ' Problem in "ig_clim_numlab" deallocation in prism_terminate'
172            DEALLOCATE (ig_def_trans, stat = il_ERR)
173            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
174     $     ' Problem in "ig_def_trans" deallocation in prism_terminate'
175            DEALLOCATE (rg_field_trans, stat = il_ERR)
176            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
177     $   ' Problem in "rg_field_trans" deallocation in prism_terminate'
178            DEALLOCATE (dg_field_trans, stat = il_ERR)
179            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
180     $   ' Problem in "dg_field_trans" deallocation in prism_terminate'
181            DEALLOCATE (ig_number, stat = il_ERR)
182            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
183     $        ' Problem in "ig_number" deallocation in prism_terminate'
184            DEALLOCATE (cg_clim_inpfile, stat = il_ERR)
185            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
186     $  ' Problem in "cg_clim_inpfile" deallocation in prism_terminate'
187            DEALLOCATE (cg_def_inpfile, stat = il_ERR)
188            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
189     $  ' Problem in "cg_def_inpfile" deallocation in prism_terminate'
190            DEALLOCATE (cg_ignout_field, stat = il_ERR)
191            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
192     $  ' Problem in "cg_ignout_field" deallocation in prism_terminate'
193            DEALLOCATE (ig_def_numlab, stat = il_ERR)
194            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
195     $  ' Problem in "ig_def_numlab" deallocation in prism_terminate'
196            DEALLOCATE (cga_clim_locatorbf, stat = il_ERR)
197            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
198     $  ' Problem cga_clim_locatorbf deallocation in prism_terminate'
199            DEALLOCATE (cga_clim_locatoraf, stat = il_ERR)
200            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
201     $  ' Problem cga_clim_locatoraf deallocation in prism_terminate'
202            DEALLOCATE (cga_clim_locator, stat = il_ERR)
203            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
204     $  ' Problem cga_clim_locator deallocation in prism_terminate'
205            IF (allocated(ig_aux)) DEALLOCATE(ig_aux,stat = il_ERR)
206            IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
207     $  ' Problem in "ig_aux" deallocation in prism_terminate'
208            IF (lg_clim_bsend) THEN
209                CALL MPI_Buffer_Detach(dl_bufaddr, il_bufsizebyt, 
210     $              mpi_err)
211                DEALLOCATE (dg_bufsend, stat = il_ERR)
212                IF (il_ERR.ne.CLIM_Ok) WRITE(nulprt,*)
213     $  ' Problem in "dg_bufsend" deallocation in prism_terminate'
214            ENDIF
215        ENDIF
216      END DO
217      DEALLOCATE (modtid, stat=il_err)
218      IF (il_ERR.ne.0) WRITE(nulprt,*)
219     $    'Error in modtid deallocation in prism_terminate'
220      WRITE(nulprt, *) 'lg_mpiflag=', lg_mpiflag
221c
222      info = 0.0   
223      IF (.NOT. lg_mpiflag ) THEN
224          WRITE(nulprt,FMT='(A)') 
225     $    'Calling MPI_Finalize in prism_terminate ...'
226          CALL MPI_Finalize ( info )
227      ELSE
228          WRITE(nulprt,FMT='(A)') 
229     $    'No call of MPI_Finalize in prism_terminate.'
230      ENDIF     
231c
232      WRITE(nulprt,FMT='(A,I3,A)')
233     *     'Quit - exit status <mpi ',info,'>'
234c
235c     ----------------------------------------------------------------
236c
237 1010 CONTINUE
238      CLOSE(nulprt)
239      RETURN
240      END
Note: See TracBrowser for help on using the repository browser.