source: branches/NERC/dev_r5518_GO6_CO2_cmip/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90 @ 9309

Last change on this file since 9309 was 9163, checked in by frrh, 3 years ago

Add code from Julien Palmieri's Met Office GMED ticket 338.
This incorporates code from branches/NERC/dev_r5518_GO6_package_trdtrc
revisions 8454:9020 inclusive.

File size: 5.0 KB
Line 
1MODULE trcsms_medusa
2   !!======================================================================
3   !!                         ***  MODULE trcsms_medusa  ***
4   !! TOP :   Main module of the MEDUSA tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
7   !!              -   !  2008-08  (K. Popova) adaptation for MEDUSA
8   !!              -   !  2008-11  (A. Yool) continuing adaptation for MEDUSA
9   !!              -   !  2010-03  (A. Yool) updated for branch inclusion
10   !!              -   !  2017-08  (A. Yool) amend for slow detritus bug
11   !!----------------------------------------------------------------------
12#if defined key_medusa
13   !!----------------------------------------------------------------------
14   !!   'key_medusa'                                       bio tracers
15   !!----------------------------------------------------------------------
16   !! trc_sms_medusa   : MEDUSA_TRC model main routine
17   !!----------------------------------------------------------------------
18   USE par_trc         ! TOP parameters
19   USE oce_trc
20   USE trc
21   USE trcbio_medusa
22   USE trcopt_medusa
23   USE trcsed_medusa
24   USE trcavg_medusa
25   !! for SMS trends
26   USE par_medusa,    ONLY: jp_msa0, jp_msa1, jp_medusa
27   USE par_oce,       ONLY: jpi, jpj, jpk
28   USE trd_oce,       ONLY: jptra_sms, l_trdtrc
29   USE trdtrc
30
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   trc_sms_medusa   ! called by trcsms.F90 module
36
37   !!----------------------------------------------------------------------
38   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
39   !! $Id$
40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE trc_sms_medusa( kt )
46      !!----------------------------------------------------------------------
47      !!                     ***  trc_sms_medusa  *** 
48      !!
49      !! ** Purpose :   main routine of MEDUSA_TRC model
50      !!
51      !! ** Method  : -
52      !!----------------------------------------------------------------------
53      INTEGER, INTENT(in) :: kt   ! ocean time-step index
54      !! Loop variables
55      INTEGER :: jn
56      !! trend temporary array:
57      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrmed
58
59
60# if defined key_debug_medusa
61         IF(lwp) WRITE(numout,*) ' MEDUSA inside trc_sms_medusa'
62         CALL flush(numout)
63# endif
64
65      IF( kt == nittrc000 ) THEN
66       IF(lwp) WRITE(numout,*)
67       IF(lwp) WRITE(numout,*) ' trc_sms_medusa:  MEDUSA model'
68       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
69      ENDIF
70
71      !! MEDUSA SMS trends:
72      IF( l_trdtrc ) THEN
73          CALL wrk_alloc( jpi, jpj, jpk, jp_medusa, ztrmed )
74          ztrmed(:,:,:,:)=0.0 
75          DO jn = 1, jp_medusa
76            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)
77          END DO
78      END IF
79
80      CALL trc_avg_medusa( kt ) ! rolling average module
81# if defined key_debug_medusa
82      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_avg_medusa'
83      CALL flush(numout)
84# endif
85     
86      CALL trc_opt_medusa( kt ) ! optical model
87# if defined key_debug_medusa
88      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_opt_medusa'
89      CALL flush(numout)
90# endif
91
92      !! AXY & JPALM (28/02/17): call dust before trc_bio_medusa (because of coupling)
93      CALL trc_sed_medusa_dust( kt ) ! dust submodel
94# if defined key_debug_medusa
95      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa_dust'
96      CALL flush(numout)
97# endif
98
99# if defined key_kill_medusa
100      !! MEDUSA skipped
101      IF(lwp) WRITE(numout,*) ' MEDUSA killed at kt =', kt
102      CALL flush(numout)
103# else
104      CALL trc_bio_medusa( kt ) ! biological model
105#  if defined key_debug_medusa
106      IF(lwp) WRITE(numout,*) ' MEDUSA done trc_bio_medusa'
107      CALL flush(numout)
108#  endif
109     
110!! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90)
111!!       CALL trc_sed_medusa( kt ) ! sedimentation model
112!! #  if defined key_debug_medusa
113!!       IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa'
114!!       CALL flush(numout)
115!! #  endif
116# endif
117
118      !! MEDUSA SMS trends:
119      IF( l_trdtrc ) THEN
120          DO jn = 1, jp_medusa
121            ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)-ztrmed(:,:,:,jn)
122            CALL trd_trc( ztrmed(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
123          END DO
124          CALL wrk_dealloc( jpi, jpj, jpk, jp_medusa, ztrmed )
125      END IF
126
127
128   END SUBROUTINE trc_sms_medusa
129   
130#else
131   !!----------------------------------------------------------------------
132   !!   Dummy module                                        No MEDUSA model
133   !!----------------------------------------------------------------------
134CONTAINS
135   SUBROUTINE trc_sms_medusa( kt )             ! Empty routine
136      INTEGER, INTENT( in ) ::   kt
137      WRITE(*,*) 'trc_sms_medusa: You should not have seen this print! error?', kt
138   END SUBROUTINE trc_sms_medusa
139#endif
140
141   !!======================================================================
142END MODULE trcsms_medusa
143
Note: See TracBrowser for help on using the repository browser.