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 branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/MY_TRC – NEMO

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90 @ 3160

Last change on this file since 3160 was 3160, checked in by cetlod, 12 years ago

Add timing in TOP routines

  • Property svn:keywords set to Id
File size: 4.3 KB
Line 
1MODULE trcsms_my_trc
2   !!======================================================================
3   !!                         ***  MODULE trcsms_my_trc  ***
4   !! TOP :   Main module of the MY_TRC tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
7   !!----------------------------------------------------------------------
8#if defined key_my_trc
9   !!----------------------------------------------------------------------
10   !!   'key_my_trc'                                               CFC tracers
11   !!----------------------------------------------------------------------
12   !! trc_sms_my_trc       : MY_TRC model main routine
13   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms
14   !!----------------------------------------------------------------------
15   USE par_trc         ! TOP parameters
16   USE oce_trc         ! Ocean variables
17   USE trc             ! TOP variables
18   USE trdmod_oce
19   USE trdmod_trc
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module
25   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module
26
27   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc
28   
29   !!----------------------------------------------------------------------
30   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
31   !! $Id$
32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34CONTAINS
35
36   SUBROUTINE trc_sms_my_trc( kt )
37      !!----------------------------------------------------------------------
38      !!                     ***  trc_sms_my_trc  *** 
39      !!
40      !! ** Purpose :   main routine of MY_TRC model
41      !!
42      !! ** Method  : -
43      !!----------------------------------------------------------------------
44      !
45      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
46      INTEGER ::   jn   ! dummy loop index
47      !!----------------------------------------------------------------------
48      !
49      IF( nn_timing == 1 )  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 )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
56     
57      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) )
58        trn(:,:,1,jpmyt1) = 1._wp
59        trb(:,:,1,jpmyt1) = 1._wp
60        tra(:,:,1,jpmyt1) = 0._wp
61      END WHERE
62
63      WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80)) 
64        trn(:,:,1,jpmyt2) = 1._wp
65        trb(:,:,1,jpmyt2) = 1._wp
66        tra(:,:,1,jpmyt2) = 0._wp
67      END WHERE
68
69      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
70          DO jn = jp_myt0, jp_myt1
71            ztrmyt(:,:,:) = tra(:,:,:,jn)
72            CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt )   ! save trends
73          END DO
74          CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt ) 
75      END IF
76      !
77      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_my_trc')
78      !
79   END SUBROUTINE trc_sms_my_trc
80
81
82   INTEGER FUNCTION trc_sms_my_trc_alloc()
83      !!----------------------------------------------------------------------
84      !!              ***  ROUTINE trc_sms_my_trc_alloc  ***
85      !!----------------------------------------------------------------------
86      !
87      ! ALLOCATE here the arrays specific to MY_TRC
88      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc )
89      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated
90      !
91      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays')
92      !
93   END FUNCTION trc_sms_my_trc_alloc
94
95
96#else
97   !!----------------------------------------------------------------------
98   !!   Dummy module                                        No MY_TRC model
99   !!----------------------------------------------------------------------
100CONTAINS
101   SUBROUTINE trc_sms_my_trc( kt )             ! Empty routine
102      INTEGER, INTENT( in ) ::   kt
103      WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt
104   END SUBROUTINE trc_sms_my_trc
105#endif
106
107   !!======================================================================
108END MODULE trcsms_my_trc
Note: See TracBrowser for help on using the repository browser.