source: NEMO/trunk/src/TOP/CFC/trcini_cfc.F90 @ 14725

Last change on this file since 14725 was 13295, checked in by acc, 11 months ago

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

  • Property svn:keywords set to Id
File size: 5.6 KB
Line 
1MODULE trcini_cfc
2   !!======================================================================
3   !!                         ***  MODULE trcini_cfc  ***
4   !! TOP :   initialisation of the CFC tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)
7   !!----------------------------------------------------------------------
8   !!----------------------------------------------------------------------
9   !! trc_ini_cfc      : CFC model initialisation
10   !!----------------------------------------------------------------------
11   USE oce_trc         ! Ocean variables
12   USE par_trc         ! TOP parameters
13   USE trc             ! TOP variables
14   USE trcnam_cfc      ! CFC SMS namelist
15   USE trcsms_cfc      ! CFC sms trends
16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
21
22   INTEGER  ::   inum                   ! unit number
23   REAL(wp) ::   ylats = -10.           ! 10 degrees south
24   REAL(wp) ::   ylatn =  10.           ! 10 degrees north
25
26   !! * Substitutions
27#  include "do_loop_substitute.h90"
28   !!----------------------------------------------------------------------
29   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE trc_ini_cfc( Kmm )
36      !!----------------------------------------------------------------------
37      !!                     ***  trc_ini_cfc  *** 
38      !!
39      !! ** Purpose :   initialization for cfc model
40      !!
41      !! ** Method  : - Read the namcfc namelist and check the parameter values
42      !!----------------------------------------------------------------------
43      INTEGER, INTENT(in)  ::  Kmm  ! time level indices
44      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr
45      INTEGER  ::  iskip = 6        ! number of 1st descriptor lines
46      REAL(wp) ::  zyy, zyd
47      CHARACTER(len = 20)  ::  cltra
48      !!----------------------------------------------------------------------
49      !
50      CALL trc_nam_cfc
51      !
52      IF(lwp) WRITE(numout,*)
53      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
54      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
55      !
56      IF(lwp) WRITE(numout,*) 'Read annual atmospheric concentratioins from formatted file : ' // TRIM(clname)
57     
58      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
59      REWIND(inum)
60     
61      ! compute the number of year in the file
62      ! file starts in 1931 do jn represent the year in the century
63      jn = 31 
64      DO
65        READ(inum,'(1x)',END=100) 
66        jn = jn + 1
67      END DO
68 100  jpyear = jn - 1 - iskip
69      IF ( lwp) WRITE(numout,*) '   --->  ', jpyear ,' years read'
70      !                                ! Allocate CFC arrays
71
72      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr )
73      IF( ierr > 0 ) THEN
74         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN
75      ENDIF
76      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' )
77
78
79      ! Initialization of boundaries conditions
80      ! ---------------------------------------
81      xphem (:,:)    = 0._wp
82      p_cfc(:,:,:)   = 0._wp
83     
84      ! Initialization of qint in case of  no restart
85      !----------------------------------------------
86      qtr_cfc(:,:,:) = 0._wp
87      IF( .NOT. ln_rsttr ) THEN   
88         IF(lwp) THEN
89            WRITE(numout,*)
90            WRITE(numout,*) 'Initialisation of qint ; No restart : qint equal zero '
91         ENDIF
92         qint_cfc(:,:,:) = 0._wp
93         DO jl = 1, jp_cfc
94            jn = jp_cfc0 + jl - 1
95            tr(:,:,:,jn,Kmm) = 0._wp
96         END DO
97      ENDIF
98
99      REWIND(inum)
100     
101      DO jm = 1, iskip        ! Skip over 1st six descriptor lines
102         READ(inum,'(1x)')
103      END DO
104      ! file starts in 1931 do jn represent the year in the century.jhh
105      ! Read file till the end
106      jn = 31
107      DO
108        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3)
109        IF( io < 0 ) exit
110        jn = jn + 1
111      END DO
112
113      !p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years
114      !p_cfc(33,1:2,1) = 8.e-4
115      !p_cfc(34,1:2,1) = 1.e-6
116      !p_cfc(35,1:2,1) = 2.e-3
117      !p_cfc(36,1:2,1) = 4.e-3
118      !p_cfc(37,1:2,1) = 6.e-3
119      !p_cfc(38,1:2,1) = 8.e-3
120      !p_cfc(39,1:2,1) = 1.e-2
121      IF(lwp) THEN        ! Control print
122         WRITE(numout,*)
123         WRITE(numout,*) ' Year   c11NH     c11SH     c12NH     c12SH     SF6NH     SF6SH'
124         DO jn = 30, jpyear
125            WRITE(numout, '( 1I4, 6F10.4)') jn, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3)
126         END DO
127      ENDIF
128
129
130      ! Interpolation factor of atmospheric partial pressure
131      ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
132      !---------------------------------------------------------------------------------------
133      zyd = ylatn - ylats     
134      DO_2D( 1, 1, 1, 1 )
135         IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0
136         ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0
137         ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
138         ENDIF
139      END_2D
140      !
141      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done'
142      IF(lwp) WRITE(numout,*) ' '
143      !
144   END SUBROUTINE trc_ini_cfc
145
146   !!======================================================================
147END MODULE trcini_cfc
Note: See TracBrowser for help on using the repository browser.