New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
stpctl_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/stpctl_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007

  • Property svn:executable set to *
File size: 10.0 KB
Line 
1MODULE stpctl_tam
2#ifdef key_tam
3   !!==============================================================================
4   !!                       ***  MODULE  stpctl_tam  ***
5   !! Ocean run control :  gross check of the ocean time stepping
6   !!                      Tangent and adjoint module
7   !!==============================================================================
8   !! History of the direct module:
9   !!            OPA  ! 1991-03  (G. Madec) Original code
10   !!            6.0  ! 1992-06  (M. Imbard)
11   !!            8.0  ! 1997-06  (A.M. Treguier)
12   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
13   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
14   !! History of the T&A module:
15   !!            3.0  ! 2009-??  (A. Vidard) orignal version
16   !!            3.2  ! 2010-04  (A. Vidard) nemo3.2 update
17   !!----------------------------------------------------------------------
18
19   !!----------------------------------------------------------------------
20   !!   stp_ctl_tan      : Control the run
21   !!   stp_ctl_adj      : Control the run
22   !!----------------------------------------------------------------------
23   !! * Modules used
24   USE in_out_manager
25   USE par_oce
26   USE oce_tam
27   USE dom_oce
28   USE sol_oce
29   USE lib_mpp
30   USE dynspg_oce
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Accessibility
36   PUBLIC stp_ctl_tan           ! routine called by steptan.F90
37   PUBLIC stp_ctl_adj           ! routine called by stepadj.F90
38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE stp_ctl_tan( kt, kindic, ksign )
43      !!----------------------------------------------------------------------
44      !!                    ***  ROUTINE stp_ctl_tan  ***
45      !!
46      !! ** Purpose of the direct routine:   Control the run
47      !!
48      !! ** Method  : - Save the time step in numstp
49      !!              - Print it each 50 time steps
50      !!              - Print solver statistics in numsol
51      !!              - Stop the run IF problem for the solver ( indec < 0 )
52      !!
53      !!----------------------------------------------------------------------
54      !! * Arguments
55      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
56      INTEGER, INTENT( in ) ::   ksign
57      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
58
59      !! * local declarations
60      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
61      INTEGER  ::   ii, ij, ik                 ! temporary integers
62      REAL(wp) ::   zumax, zvmax, ztmax, zsmax ! temporary scalars
63      INTEGER, DIMENSION(3) ::   ilocu         !
64      INTEGER, DIMENSION(3) ::   ilocv         !
65      INTEGER, DIMENSION(3) ::   iloct         !
66      INTEGER, DIMENSION(3) ::   ilocs         !
67      CHARACTER(len=80) :: clname
68      LOGICAL :: lfirst =.TRUE.
69      IF( kt == nit000 .AND. lwp .AND. lfirst ) THEN
70         WRITE(numout,*)
71         WRITE(numout,*) 'stp_ctl_tan : time-stepping control'
72         WRITE(numout,*) '~~~~~~~~~~~'
73         ! open time.step file
74         clname = 'time_tan.step'
75         CALL ctl_opn( numstp, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
76         lfirst = .FALSE.
77      ENDIF
78
79      IF(lwp) WRITE(numstp, '(1x, i8)' ) kt        !* save the current time step in numstp
80      IF(lwp) REWIND(numstp)                       !  --------------------------
81
82      ! elliptic solver statistics (if required)
83      ! --------------------------
84      IF( lk_dynspg_flt ) THEN
85      ! Solver
86      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
87
88      ! Islands (if exist)
89!!!!AV TO DO      IF( lk_isl )   CALL isl_stp_ctl_tan( kt, kindic )
90
91
92      ! Output in numwso and numwvo IF kindic<0
93      ! ---------------------------------------
94      !    (i.e. problem for the solver)
95      IF( kindic < 0 ) THEN
96         IF(lwp) THEN
97            WRITE(numout,*) ' stpctl_tan: the elliptic solver DO not converge or explode'
98            WRITE(numout,*) ' ========= '
99            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
100            WRITE(numout,*)
101           WRITE(numout,*) ' =========  *******************************'
102         ENDIF
103      ENDIF
104      ENDIF
105
1069200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e30.18,' b :',e30.18)
107
108      ! Test maximum of tangent fields
109      ! ------------------------
110
111      ! 1. zonal velocity
112      ! -----------------
113
114      !! zumax = MAXVAL( ABS( un_tl(:,:,:) ) )   ! slower than the following loop on NEC SX5
115      zumax = 0.e0
116      DO jk = 1, jpk
117         DO jj = 1, jpj
118            DO ji = 1, jpi
119               zumax = MAX(zumax,ABS(un_tl(ji,jj,jk)))
120          END DO
121        END DO
122      END DO
123      IF( lk_mpp )   CALL mpp_max( zumax )       ! max over the global domain
124
125      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
126      IF( zumax > 50._wp) THEN
127         IF( lk_mpp ) THEN
128            CALL mpp_maxloc(ABS(un_tl),umask,zumax,ii,ij,ik)
129         ELSE
130            ilocu = MAXLOC( ABS( un_tl(:,:,:) ) )
131            ii = ilocu(1) + nimpp - 1
132            ij = ilocu(2) + njmpp - 1
133            ik = ilocu(3)
134         ENDIF
135         IF(lwp) THEN
136            WRITE(numout,cform_err)
137            WRITE(numout,*) ' stpctl_tan: the zonal velocity is larger than 50 m/s'
138            WRITE(numout,*) ' ========= '
139            WRITE(numout,9400) kt, zumax, ii, ij, ik
140            WRITE(numout,*)
141         ENDIF
142         kindic = -3
143
144      ENDIF
1459400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5)
146      ! 2. meridional velocity
147      ! ----------------------
148      zvmax = 0.e0
149      DO jk = 1, jpk
150         DO jj = 1, jpj
151            DO ji = 1, jpi
152               zvmax = MAX(zvmax,ABS(vn_tl(ji,jj,jk)))
153          END DO
154        END DO
155      END DO
156      IF( lk_mpp )   CALL mpp_max( zvmax )   ! max over the global domain
157
158      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(V) max: ', zvmax
159      IF( zvmax > 50.) THEN
160         IF( lk_mpp ) THEN
161            CALL mpp_maxloc(ABS(vn_tl),vmask,zvmax,ii,ij,ik)
162         ELSE
163            ilocv = MAXLOC( ABS( vn_tl(:,:,:) ) )
164            ii = ilocv(1) + nimpp - 1
165            ij = ilocv(2) + njmpp - 1
166            ik = ilocv(3)
167         ENDIF
168         IF(lwp) THEN
169            WRITE(numout,cform_err)
170            WRITE(numout,*) ' stpctl_tan: the meridional  velocity is larger than 50 m/s'
171            WRITE(numout,*) ' ========= '
172            WRITE(numout,9410) kt, zvmax, ii, ij, ik
173            WRITE(numout,*)
174         ENDIF
175         kindic = -3
176      ENDIF
1779410  FORMAT (' kt=',i6,' max abs(V): ',1pg11.4,', i j k: ',3i5)
178      ! 3. Temperature
179      ! ----------------------
180      ztmax = 0.e0
181      DO jk = 1, jpk
182         DO jj = 1, jpj
183            DO ji = 1, jpi
184               ztmax = MAX(ztmax,ABS(tsn_tl(ji,jj,jk,jp_tem)))
185          END DO
186        END DO
187      END DO
188      IF( lk_mpp )   CALL mpp_max( ztmax )   ! max over the global domain
189
190      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(T) max: ', zTmax
191      IF( ztmax > 80.) THEN
192         IF( lk_mpp ) THEN
193            CALL mpp_maxloc(ABS(tsn_tl(:,:,:,jp_tem)),tmask,ztmax,ii,ij,ik)
194         ELSE
195            iloct = MAXLOC( ABS( tsn_tl(:,:,:,jp_tem) ) )
196            ii = iloct(1) + nimpp - 1
197            ij = iloct(2) + njmpp - 1
198            ik = iloct(3)
199         ENDIF
200         IF(lwp) THEN
201            WRITE(numout,cform_err)
202            WRITE(numout,*) ' stpctl_tan: the temperature is larger than 80 K'
203            WRITE(numout,*) ' ========= '
204            WRITE(numout,9420) kt, ztmax, ii, ij, ik
205            WRITE(numout,*)
206         ENDIF
207         kindic = -3
208      ENDIF
2099420  FORMAT (' kt=',i6,' max abs(T): ',1pg11.4,', i j k: ',3i5)
210
211      ! 3. Salinity
212      ! ----------------------
213      zsmax = 0.e0
214      DO jk = 1, jpk
215         DO jj = 1, jpj
216            DO ji = 1, jpi
217               zsmax = MAX(zsmax,ABS(tsn_tl(ji,jj,jk,jp_sal)))
218          END DO
219        END DO
220      END DO
221      IF( lk_mpp )   CALL mpp_max( zsmax )   ! max over the global domain
222
223      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(S) max: ', zsmax
224      IF( zsmax > 100.) THEN
225         IF( lk_mpp ) THEN
226            CALL mpp_maxloc(ABS(tsn_tl(:,:,:,jp_sal)),tmask,zsmax,ii,ij,ik)
227         ELSE
228            ilocs = MAXLOC( ABS( tsn_tl(:,:,:,jp_sal) ) )
229            ii = ilocs(1) + nimpp - 1
230            ij = ilocs(2) + njmpp - 1
231            ik = ilocs(3)
232         ENDIF
233         IF(lwp) THEN
234            WRITE(numout,cform_err)
235            WRITE(numout,*) ' stpctl_tan: the Salinity is larger than 100 o/oo'
236            WRITE(numout,*) ' ========== '
237            WRITE(numout,9430) kt, zsmax, ii, ij, ik
238            WRITE(numout,*)
239         ENDIF
240         kindic = -3
241      ENDIF
2429430  FORMAT (' kt=',i6,' max abs(S): ',1pg11.4,', i j k: ',3i5)
243
244   END SUBROUTINE stp_ctl_tan
245   SUBROUTINE stp_ctl_adj( kt, kindic, ksign )
246      !!----------------------------------------------------------------------
247      !!                    ***  ROUTINE stp_ctl_adj  ***
248      !!
249      !! ** Purpose of the direct routine:   Control the run
250      !!
251      !! ** Method  : - Save the time step in numstp
252      !!              - Print it each 50 time steps
253      !!              - Print solver statistics in numsol
254      !!              - Stop the run IF problem for the solver ( indec < 0 )
255      !!
256      !! History :
257      !!        !  91-03  ()
258      !!        !  91-11  (G. Madec)
259      !!        !  92-06  (M. Imbard)
260      !!        !  97-06  (A.M. Treguier)
261      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
262      !!----------------------------------------------------------------------
263      !! * Arguments
264      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
265      INTEGER, INTENT( in ) ::   ksign
266      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
267
268      !! * local declarations
269
270   END SUBROUTINE stp_ctl_adj
271
272   !!======================================================================
273#endif
274END MODULE stpctl_tam
Note: See TracBrowser for help on using the repository browser.