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 NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/TOP – NEMO

source: NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/TOP/trcice.F90 @ 11831

Last change on this file since 11831 was 11831, checked in by laurent, 4 years ago

Update the branch to r11830 of the trunk!

  • Property svn:keywords set to Id
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   USE oce_trc        ! shared variables between ocean and passive tracers
15   USE trc            ! passive tracers common variables
16   USE trcice_cfc     ! CFC      initialisation
17   USE trcice_pisces  ! PISCES   initialisation
18   USE trcice_c14     ! C14 bomb initialisation
19   USE trcice_age     ! AGE      initialisation
20   USE trcice_my_trc  ! MY_TRC   initialisation
21   
22   IMPLICIT NONE
23   PRIVATE
24   
25   PUBLIC   trc_ice_ini   ! called by trc_nam
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_ice_ini
35      !!---------------------------------------------------------------------
36      !!                     ***  ROUTINE trc_ice_ini ***
37      !!
38      !! ** Purpose :   Initialization of the ice module for tracers
39      !!
40      !! ** Method  : -
41      !!---------------------------------------------------------------------
42      !
43      IF(lwp) THEN
44         WRITE(numout,*)
45         WRITE(numout,*) 'trc_ice_ini : Initialize sea ice tracer boundary condition'
46         WRITE(numout,*) '~~~~~~~~~~~~~'
47      ENDIF
48      !
49      CALL trc_nam_ice
50      !
51      trc_i(:,:,:) = 0._wp   ! by default
52      trc_o(:,:,:) = 0._wp   ! 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   END SUBROUTINE trc_ice_ini
63
64
65   SUBROUTINE trc_nam_ice
66      !!---------------------------------------------------------------------
67      !!                     ***  ROUTINE trc_nam_ice ***
68      !!
69      !! ** Purpose :   Read the namelist for the ice effect on tracers
70      !!
71      !! ** Method  : -
72      !!---------------------------------------------------------------------
73      INTEGER :: jn      ! dummy loop indices
74      INTEGER :: ios, ierr     ! Local integer output status for namelist read
75      !
76      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) ::   sn_tri_tracer
77      !!
78      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer
79      !!---------------------------------------------------------------------
80      !
81      IF(lwp) THEN
82         WRITE(numout,*)
83         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice'
84         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
85      ENDIF
86      !
87      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data
88      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901)
89 901  IF( ios /= 0 )   CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ' )
90      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients
91      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 )
92 902  IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist' )
93
94      IF( lwp ) THEN
95         WRITE(numout,*) ' '
96         WRITE(numout,*) '   Namelist : namtrc_ice'
97         WRITE(numout,*) '      Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr
98      ENDIF
99      !
100      ! Assign namelist stuff
101      DO jn = 1, jptra
102         trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio
103         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr
104         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o
105      END DO
106      !
107   END SUBROUTINE trc_nam_ice
108
109#else
110   !!----------------------------------------------------------------------
111   !!  Empty module :                                     No passive tracer
112   !!----------------------------------------------------------------------
113CONTAINS
114   SUBROUTINE trc_ice_ini                   ! Dummy routine   
115   END SUBROUTINE trc_ice_ini
116   SUBROUTINE trc_nam_ice
117   END SUBROUTINE trc_nam_ice
118#endif
119
120   !!======================================================================
121END MODULE trcice
Note: See TracBrowser for help on using the repository browser.