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_my_trc.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/MY_TRC/trcsms_my_trc.F90 @ 10966

Last change on this file since 10966 was 10966, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert TOP routines in TOP/TRP directory and all knock on effects of these conversions. SETTE tested (GYRE_PISCES only)

  • Property svn:keywords set to Id
File size: 3.5 KB
Line 
1MODULE trcsms_my_trc
2   !!======================================================================
3   !!                         ***  MODULE trcsms_my_trc  ***
4   !! TOP :   Main module of the MY_TRC tracers
5   !!======================================================================
6   !! History :      !  2007  (C. Ethe, G. Madec)  Original code
7   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture
8   !!----------------------------------------------------------------------
9   !! trc_sms_my_trc       : MY_TRC model main routine
10   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms
11   !!----------------------------------------------------------------------
12   USE par_trc         ! TOP parameters
13   USE oce_trc         ! Ocean variables
14   USE trc             ! TOP variables
15   USE trd_oce
16   USE trdtrc
17   USE trcbc, only : trc_bc
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module
23   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module
24
25   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc
26
27   !!----------------------------------------------------------------------
28   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
29   !! $Id$
30   !! Software governed by the CeCILL license (see ./LICENSE)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE trc_sms_my_trc( kt, Kmm, Krhs )
35      !!----------------------------------------------------------------------
36      !!                     ***  trc_sms_my_trc  ***
37      !!
38      !! ** Purpose :   main routine of MY_TRC model
39      !!
40      !! ** Method  : -
41      !!----------------------------------------------------------------------
42      !
43      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
44      INTEGER, INTENT(in) ::   Kmm, Krhs  ! time level indices
45      INTEGER ::   jn   ! dummy loop index
46      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrmyt
47      !!----------------------------------------------------------------------
48      !
49      IF( ln_timing )   CALL timing_start('trc_sms_my_trc')
50      !
51      IF(lwp) WRITE(numout,*)
52      IF(lwp) WRITE(numout,*) ' trc_sms_my_trc:  MY_TRC model'
53      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
54
55      IF( l_trdtrc )  ALLOCATE( ztrmyt(jpi,jpj,jpk) )
56
57      CALL trc_bc ( kt, Kmm, Krhs )       ! tracers: surface and lateral Boundary Conditions
58
59      ! add here the call to BGC model
60
61      ! Save the trends in the mixed layer
62      IF( l_trdtrc ) THEN
63          DO jn = jp_myt0, jp_myt1
64            ztrmyt(:,:,:) = tra(:,:,:,jn)
65            CALL trd_trc( ztrmyt, jn, jptra_sms, kt, Kmm )   ! save trends
66          END DO
67          DEALLOCATE( ztrmyt )
68      END IF
69      !
70      IF( ln_timing )   CALL timing_stop('trc_sms_my_trc')
71      !
72   END SUBROUTINE trc_sms_my_trc
73
74
75   INTEGER FUNCTION trc_sms_my_trc_alloc()
76      !!----------------------------------------------------------------------
77      !!              ***  ROUTINE trc_sms_my_trc_alloc  ***
78      !!----------------------------------------------------------------------
79      !
80      ! ALLOCATE here the arrays specific to MY_TRC
81      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc )
82      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated
83      !
84      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sms_my_trc_alloc : failed to allocate arrays' )
85      !
86   END FUNCTION trc_sms_my_trc_alloc
87
88   !!======================================================================
89END MODULE trcsms_my_trc
Note: See TracBrowser for help on using the repository browser.