source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90 @ 7771

Last change on this file since 7771 was 7771, checked in by frrh, 4 years ago

Apply optimisations to various areas of code replacing the use of
allocated pointers with straightforward direct ALLOCATE and DEALLOCATE
operations.

These optimisations largely have an impact in models featuring MEDUSA,
i.e. those with significant numbers of tracers, although they are
expected to have a small impact in all configurations.

Code developed and tested in NEMO branch branches/UKMO/dev_r5518_optim_GO6_alloc
Tested in stand-alone GO6-GSI8, GO6-GSI8-MEDUSA and UKESM coupled models.
NEMO ticket #1821 documents this change further.

File size: 13.9 KB
Line 
1MODULE trcldf
2   !!======================================================================
3   !!                       ***  MODULE  trcldf  ***
4   !! Ocean Passive tracers : lateral diffusive trends
5   !!=====================================================================
6   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
7   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP models
12   !!----------------------------------------------------------------------
13   !!----------------------------------------------------------------------
14   !!   trc_ldf     : update the tracer trend with the lateral diffusion
15   !!       ldf_ctl : initialization, namelist read, and parameters control
16   !!----------------------------------------------------------------------
17   USE oce_trc         ! ocean dynamics and active tracers
18   USE trc             ! ocean passive tracers variables
19   USE trcnam_trp      ! passive tracers transport namelist variables
20   USE ldftra_oce      ! lateral diffusion coefficient on tracers
21   USE ldfslp          ! ???
22   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
23   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
24   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine)
25   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
26   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine)
27   USE trd_oce
28   USE trdtra
29   USE prtctl_trc      ! Print control
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   trc_ldf    ! called by step.F90
35   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
36   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
37   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46
47CONTAINS
48
49   SUBROUTINE trc_ldf( kt )
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE tra_ldf  ***
52      !!
53      !! ** Purpose :   compute the lateral ocean tracer physics.
54      !!
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
57      !!
58      INTEGER            :: ji, jj, jk, jn
59      REAL(wp)           :: zdep
60      CHARACTER (len=22) :: charout
61      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrtrd
62      !!----------------------------------------------------------------------
63      !
64      IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
65      !
66      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options
67
68      rldf = rldf_rat
69      !
70      r_fact_lap(:,:,:) = 1.
71      DO jk= 1, jpk
72         DO jj = 1, jpj
73            DO ji = 1, jpi
74               IF( fsdept(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
75                  zdep = MAX( fsdept(ji,jj,jk) - 1000., 0. ) / 1000.
76                  r_fact_lap(ji,jj,jk) = MAX( 1., rn_fact_lap * EXP( -zdep ) )
77               ENDIF
78            END DO
79         END DO
80      END DO
81      !
82      IF( l_trdtrc )  THEN
83         ALLOCATE( ztrtrd ( 1:jpi, 1:jpj, 1:jpk, 1:jptra) )
84         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
85      ENDIF
86
87      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
88      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra        )  ! iso-level laplacian
89      CASE ( 1 )                                                                                            ! rotated laplacian
90                       IF( ln_traldf_grif ) THEN
91                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
92                       ELSE
93                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
94                       ENDIF
95      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian
96      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
97         !
98      CASE ( -1 )                                     ! esopa: test all possibility with control print
99         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )
100         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
101                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
102         IF( ln_traldf_grif ) THEN
103            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
104         ELSE
105            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
106         ENDIF
107         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
108                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
109         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )
110         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
111                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
112         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )
113         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
114                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
115      END SELECT
116      !
117      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
118        DO jn = 1, jptra
119           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
120           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
121        END DO
122        DEALLOCATE( ztrtrd )
123      ENDIF
124      !                                          ! print mean trends (used for debugging)
125      IF( ln_ctl )   THEN
126         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
127                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
128      ENDIF
129      !
130      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
131      !
132   END SUBROUTINE trc_ldf
133
134
135   SUBROUTINE ldf_ctl
136      !!----------------------------------------------------------------------
137      !!                  ***  ROUTINE ldf_ctl  ***
138      !!
139      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
140      !!
141      !! ** Method  :   set nldf from the namtra_ldf logicals
142      !!      nldf == -2   No lateral diffusion
143      !!      nldf == -1   ESOPA test: ALL operators are used
144      !!      nldf ==  0   laplacian operator
145      !!      nldf ==  1   Rotated laplacian operator
146      !!      nldf ==  2   bilaplacian operator
147      !!      nldf ==  3   Rotated bilaplacian
148      !!----------------------------------------------------------------------
149      INTEGER ::   ioptio, ierr         ! temporary integers
150      !!----------------------------------------------------------------------
151
152      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
153         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
154            rldf_rat = 1.0_wp
155         ELSE
156            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
157         END IF
158      ELSE
159         rldf_rat = rn_ahtrc_0 / rn_aht_0
160      END IF
161      !  Define the lateral mixing oparator for tracers
162      ! ===============================================
163
164      !                               ! control the input
165      ioptio = 0
166      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
167      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
168      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
169      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
170      ioptio = 0
171      IF( ln_trcldf_level )   ioptio = ioptio + 1
172      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
173      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
174      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
175
176      ! defined the type of lateral diffusion from ln_trcldf_... logicals
177      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
178      ierr = 0
179      IF( ln_trcldf_lap ) THEN       ! laplacian operator
180         IF ( ln_zco ) THEN                ! z-coordinate
181            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
182            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
183            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
184         ENDIF
185         IF ( ln_zps ) THEN             ! z-coordinate
186            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
187            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
188            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
189         ENDIF
190         IF ( ln_sco ) THEN             ! z-coordinate
191            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
192            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
193            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
194         ENDIF
195      ENDIF
196
197      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
198         IF ( ln_zco ) THEN                ! z-coordinate
199            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
200            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
201            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
202         ENDIF
203         IF ( ln_zps ) THEN             ! z-coordinate
204            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
205            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
206            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
207         ENDIF
208         IF ( ln_sco ) THEN             ! z-coordinate
209            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
210            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
211            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
212         ENDIF
213      ENDIF
214
215      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
216      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
217      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
218           CALL ctl_stop( '          eddy induced velocity on tracers',   &
219           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
220      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
221         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
222#if defined key_offline
223         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
224#endif
225      ENDIF
226
227      IF( lk_esopa ) THEN
228         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
229         nldf = -1
230      ENDIF
231
232      IF(lwp) THEN
233         WRITE(numout,*)
234         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
235         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
236         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
237         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
238         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
239         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
240      ENDIF
241
242      IF( ln_trcldf_bilap ) THEN
243         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
244         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
245      ELSE
246         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
247         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
248      ENDIF
249
250      ! ratio between active and passive tracers diffusive coef.
251      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
252         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
253            rldf_rat = 1.0_wp
254         ELSE
255            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
256         END IF
257      ELSE
258         rldf_rat = rn_ahtrc_0 / rn_aht_0
259      END IF
260      IF( rldf_rat < 0 ) THEN
261         IF( .NOT.lk_offline ) THEN
262            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
263         ELSE
264            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
265         ENDIF
266      ENDIF
267      !
268   END SUBROUTINE ldf_ctl
269#else
270   !!----------------------------------------------------------------------
271   !!   Default option                                         Empty module
272   !!----------------------------------------------------------------------
273CONTAINS
274   SUBROUTINE trc_ldf( kt )
275      INTEGER, INTENT(in) :: kt
276      WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt
277   END SUBROUTINE trc_ldf
278#endif
279   !!======================================================================
280END MODULE trcldf
Note: See TracBrowser for help on using the repository browser.