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.
trcsms_medusa.F90 in branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90 @ 8673

Last change on this file since 8673 was 8673, checked in by jpalmier, 6 years ago

JPALM -- include odd and even var group in IOM.F90 - secure SMS trends in MEDUSA - create odd and even group in fiel_def_bgc

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