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.
trclsm_cfc.F90 in branches/dev_005_AWL/NEMO/TOP_SRC/CFC – NEMO

source: branches/dev_005_AWL/NEMO/TOP_SRC/CFC/trclsm_cfc.F90 @ 1804

Last change on this file since 1804 was 1804, checked in by sga, 14 years ago

merge of trunk changes from r1782 to r1802 into NEMO branch dev_005_AWL

  • Property svn:keywords set to Id
File size: 5.2 KB
Line 
1MODULE trclsm_cfc
2   !!======================================================================
3   !!                         ***  MODULE trclsm_cfc  ***
4   !! TOP :   initialisation of some run parameters for CFC chemical model
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.cfc.h90
7   !!----------------------------------------------------------------------
8#if defined key_cfc
9   !!----------------------------------------------------------------------
10   !!   'key_cfc'                                               CFC tracers
11   !!----------------------------------------------------------------------
12   !! trc_lsm_cfc      : CFC model initialisation
13   !!----------------------------------------------------------------------
14   USE oce_trc         ! Ocean variables
15   USE par_trc         ! TOP parameters
16   USE trc             ! TOP variables
17   USE trcsms_cfc      ! CFC specific variable
18   USE in_out_manager  ! I/O manager
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   trc_lsm_cfc   ! called by trclsm.F90 module
24
25   !!----------------------------------------------------------------------
26   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
27   !! $Id$
28   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
29   !!----------------------------------------------------------------------
30
31CONTAINS
32
33   SUBROUTINE trc_lsm_cfc
34      !!-------------------------------------------------------------------
35      !!                  ***  ROUTINE trc_lsm_cfc  ***
36      !!                 
37      !! ** Purpose :   Definition some run parameter for CFC model
38      !!
39      !! ** Method  :   Read the namcfc namelist and check the parameter
40      !!       values called at the first timestep (nit000)
41      !!
42      !! ** input   :   Namelist namcfc
43      !!----------------------------------------------------------------------
44      INTEGER ::   numnatc
45#if defined key_trc_diaadd && ! defined key_iomput
46      ! definition of additional diagnostic as a structure
47      INTEGER :: jl, jn
48      TYPE DIAG
49         CHARACTER(len = 20)  :: snamedia   !: short name
50         CHARACTER(len = 80 ) :: lnamedia   !: long name
51         CHARACTER(len = 20 ) :: unitdia    !: unit
52      END TYPE DIAG
53
54      TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d
55#endif
56      !!
57      NAMELIST/namcfcdate/ ndate_beg, nyear_res
58#if defined key_trc_diaadd && ! defined key_iomput
59      NAMELIST/namcfcdia/nwritedia, cfcdia2d     ! additional diagnostics
60#endif
61      !!-------------------------------------------------------------------
62
63      ndate_beg = 300101            ! default namelist value
64      nyear_res = 1950
65
66      !                             ! Open namelist file
67      CALL ctl_opn( numnatc, 'namelist_cfc', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
68         
69      READ( numnatc , namcfcdate )     ! read namelist
70
71      IF(lwp) THEN                  ! control print
72         WRITE(numout,*)
73         WRITE(numout,*) ' trc_lsm: Read namdates, namelist for CFC chemical model'
74         WRITE(numout,*) ' ~~~~~~~'
75         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg
76         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res
77      ENDIF
78      nyear_beg = ndate_beg / 10000
79      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg
80      !
81#if defined key_trc_diaadd && ! defined key_iomput
82
83      ! Namelist namcfcdia
84      ! -------------------
85      nwritedia = 10                   ! default values
86
87      DO jl = 1, jp_cfc_2d
88         jn = jp_cfc0_2d + jl - 1 
89         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
90         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
91         ctrc2u(jn) = ' '                                       ! units
92      END DO
93
94      REWIND( numnatc )               ! read natrtd
95      READ  ( numnatc, namcfcdia )
96
97      DO jl = 1, jp_cfc_2d
98         jn = jp_cfc0_2d + jl - 1
99         ctrc2d(jn) = cfcdia2d(jl)%snamedia
100         ctrc2l(jn) = cfcdia2d(jl)%lnamedia
101         ctrc2u(jn) = cfcdia2d(jl)%unitdia
102      END DO
103
104
105      IF(lwp) THEN                   ! control print
106         WRITE(numout,*)
107         WRITE(numout,*) ' Namelist : natadd'
108         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
109         DO jl = 1, jp_cfc_2d
110            jn = jp_cfc0_2d + jl - 1
111            WRITE(numout,*) '   2d output field No : ',jn
112            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
113            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
114            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
115            WRITE(numout,*) ' '
116         END DO
117      ENDIF
118#endif
119
120   END SUBROUTINE trc_lsm_cfc
121   
122#else
123   !!----------------------------------------------------------------------
124   !!  Dummy module :                                                No CFC
125   !!----------------------------------------------------------------------
126CONTAINS
127   SUBROUTINE trc_lsm_cfc                      ! Empty routine
128   END  SUBROUTINE  trc_lsm_cfc
129#endif 
130
131   !!======================================================================
132END MODULE trclsm_cfc
Note: See TracBrowser for help on using the repository browser.