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.
trcice.F90 in branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/TOP_SRC/trcice.F90 @ 8809

Last change on this file since 8809 was 7753, checked in by mocavero, 7 years ago

Reverting trunk to remove OpenMP

File size: 5.0 KB
Line 
1MODULE trcice
2   !!======================================================================
3   !!                         ***  MODULE trcice  ***
4   !! TOP :   Manage the communication between TOP and sea ice
5   !!======================================================================
6   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
7   !!----------------------------------------------------------------------
8#if defined key_top
9   !!----------------------------------------------------------------------
10   !!   'key_top'                                                TOP models
11   !!----------------------------------------------------------------------
12   !!   trc_ice   :  Call the appropriate sea ice tracer subroutine
13   !!----------------------------------------------------------------------
14
15   USE oce_trc         ! shared variables between ocean and passive tracers
16   USE trc             ! passive tracers common variables
17   USE trcice_cfc      ! CFC      initialisation
18   USE trcice_pisces   ! PISCES   initialisation
19   USE trcice_c14      ! C14 bomb initialisation
20   USE trcice_age      ! aGE initialisation
21   USE trcice_my_trc   ! MY_TRC   initialisation
22   
23   IMPLICIT NONE
24   PRIVATE
25   
26   PUBLIC   trc_ice_ini ! called by trc_nam
27
28CONTAINS
29   
30   SUBROUTINE trc_ice_ini
31      !!---------------------------------------------------------------------
32      !!                     ***  ROUTINE trc_ice_ini ***
33      !!
34      !! ** Purpose :   Initialization of the ice module for tracers
35      !!
36      !! ** Method  : -
37      !!           
38      !!---------------------------------------------------------------------
39      ! --- Variable declarations --- !
40
41      IF(lwp) THEN
42         WRITE(numout,*)
43         WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
44         WRITE(numout,*) '~~~~~~~~~~~~~'
45      ENDIF
46
47      IF( nn_timing == 1 )  CALL timing_start('trc_ice_ini')
48      !
49      CALL trc_nam_ice
50      !
51      trc_i(:,:,:) = 0.0d0 ! by default
52      trc_o(:,:,:) = 0.0d0 ! by default
53
54      IF ( nn_ice_tr == 1 ) THEN
55         IF( ln_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model
56         IF( ll_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers
57         IF( ln_c14     )    CALL trc_ice_ini_c14          ! C14     tracer
58         IF( ln_age     )    CALL trc_ice_ini_age          ! AGE     tracer
59         IF( ln_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers
60      ENDIF
61
62      IF( nn_timing == 1 )   CALL timing_stop('trc_ice_ini')
63      !
64   END SUBROUTINE trc_ice_ini
65
66   SUBROUTINE trc_nam_ice
67      !!---------------------------------------------------------------------
68      !!                     ***  ROUTINE trc_nam_ice ***
69      !!
70      !! ** Purpose :   Read the namelist for the ice effect on tracers
71      !!
72      !! ** Method  : -
73      !!
74      !!---------------------------------------------------------------------
75      INTEGER :: jn      ! dummy loop indices
76      INTEGER :: ios, ierr     ! Local integer output status for namelist read
77      !
78      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer
79      !!
80      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
81      !!---------------------------------------------------------------------
82      !
83      IF(lwp) THEN
84         WRITE(numout,*)
85         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
86         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
87      ENDIF
88
89      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice')
90
91      !
92      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
93      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
94 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp )
95
96      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
97      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
98 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp )
99
100      IF( lwp ) THEN
101         WRITE(numout,*) ' '
102         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
103         WRITE(numout,*) ' '
104      ENDIF
105      !
106      ! Assign namelist stuff
107      DO jn = 1, jptra
108         trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio
109         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
110         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
111      END DO
112
113      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice')
114      !
115   END SUBROUTINE trc_nam_ice
116
117#else
118   !!----------------------------------------------------------------------
119   !!  Empty module :                                     No passive tracer
120   !!----------------------------------------------------------------------
121CONTAINS
122   SUBROUTINE trc_ice_ini                   ! Dummy routine   
123   END SUBROUTINE trc_ice_ini
124
125   SUBROUTINE trc_nam_ice
126   END SUBROUTINE trc_nam_ice
127
128#endif
129
130   !!======================================================================
131END MODULE trcice
Note: See TracBrowser for help on using the repository browser.