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_r12072_TOP-01_ENHANCE-11_CEthe/src/TOP/MY_TRC – NEMO

source: NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/TOP/MY_TRC/trcsms_my_trc.F90 @ 12110

Last change on this file since 12110 was 12110, checked in by cetlod, 4 years ago

merge dev_r11219_TOP-01_cethe_PISCES_LBC onto dev_r12072_TOP-01_ENHANCE-11_CEthe

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