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.
dtasst.F90 in trunk/NEMO/OPA_SRC/DTA – NEMO

source: trunk/NEMO/OPA_SRC/DTA/dtasst.F90 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.6 KB
Line 
1MODULE dtasst
2   !!======================================================================
3   !!                       ***  MODULE  dtasst  ***
4   !! Data : Sea Surface Temperature (SST)
5   
6   !!      BUG initialisation  nyearsst !!!!!!bug
7   
8   !!======================================================================
9   
10   !!----------------------------------------------------------------------
11   !!   dta_sst      : Reynolds sst data
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
16   USE in_out_manager  ! I/O manager
17   USE ocfzpt          ! ???
18   USE daymod          ! calendar
19
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Shared routine
24   PUBLIC dta_sst
25
26   !! * Shared module variables
27#if defined key_dtasst
28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   !: sst data flag
29#else
30   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .FALSE.  !: sst data flag
31#endif
32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
33      sst             !: surface temperature
34   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::   &  !:
35      rclice          !: climatological ice index (0/1) (2 months)
36   !!----------------------------------------------------------------------
37   !!   OPA 9.0 , LOCEAN-IPSL (2005)
38   !! $Header$
39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44#if defined key_dtasst
45   !!----------------------------------------------------------------------
46   !!   'key_dtasst'                                               SST data
47   !!----------------------------------------------------------------------
48
49   SUBROUTINE dta_sst( kt )
50      !!---------------------------------------------------------------------
51      !!                  ***  ROUTINE dta_sst  ***
52      !!                   
53      !! ** Purpose :   Read Reynolds weekly mean sea surface temperature
54      !!      data and update it at each time step.
55      !!
56      !! ** Method  : - Read a specific REYNOLDS daily sst in Celcius.
57      !!              -  Compute a climatological ice cover rclice (0 or 1)
58      !!
59      !! ** Action  : - sst (Celcius)
60      !!              - rclice, ice/ocean mask (0 or 1)
61      !!
62      !! History :
63      !!        !  90-03  (O. Marti and Ph Dandin)  Original code
64      !!        !  92-07  (M. Imbard)
65      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
66      !!        !  00-04  (M. Imbard)  NetCDF FORMAT
67      !!        !  00-10  (J.-P. Boulanger)  passage ORCA a TDH
68      !!        !  01-10  (A. Lazar)  Reynolds default
69      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
70      !!        !  02-11  (C. Levy)  MPP/MPI NetCDF read
71      !!----------------------------------------------------------------------
72      !! * Modules used
73      USE ioipsl
74     
75      !! * Arguments
76      INTEGER ::   kt
77
78      !! * Local save
79      INTEGER, SAVE ::   &
80      ndaysst,        &  ! new day for Reynolds sst
81      nyearsst           ! new year for Reynolds sst
82
83      !! * Local declarations
84      INTEGER ::   ji, jj
85      INTEGER ::   iprint
86      INTEGER ::   iy, iday, idy
87      INTEGER ::   istep(366)
88      INTEGER ::   ipi, ipj, ipk
89
90      REAL(wp) ::   zdate0, zdt, ztgel
91      REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk)
92      CHARACTER (len=45) ::   &
93         clname = "sst_1d.nc"      ! filename for daily SST
94      !!----------------------------------------------------------------------
95
96      IF( kt == nit000 ) THEN
97         IF(lwp) WRITE(numout,*)
98         IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data'
99         IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname
100         sst(:,:) = 0.e0   ! required for extra halos in mpp
101      ENDIF
102
103
104      ! 0. initialization
105      ! -----------------
106
107      ipi = jpiglo
108      ipj = jpjglo
109      ipk = jpk
110
111      IF( nleapy == 0 ) THEN
112         idy=365
113      ELSEIF( nleapy == 1 ) THEN
114         IF( MOD( nyear, 4 ) == 0 ) THEN
115            idy=366
116         ELSE
117            idy=365
118         ENDIF
119      ELSEIF( nleapy == 30 ) THEN
120         IF(lwp) WRITE(numout,*) 'dtasst : nleapy = 30 is not compatible'
121         IF(lwp) WRITE(numout,*) '         with existing files'
122         IF(lwp) WRITE(numout,*) 'WE STOP'
123         STOP 1234
124      ENDIF
125     
126     
127      ! 2. Open files if nyearsst
128      ! -------------------------
129
130      IF( nyearsst /= nyear ) THEN
131         nyearsst = nyear
132         iprint   = 1
133         
134         !  2.1 Define file name and record
135         
136         !   Close/open file if new year
137         
138         IF( nyearsst /= 0 )   CALL flinclo(numsst)
139         iy = nyear
140         IF(lwp) WRITE (numout,*) iy
141         IF(lwp) WRITE (numout,*) 'open sst file = ', clname
142         CALL FLUSH(numout)
143         
144         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj   &
145            , ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsst )
146         
147         IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN
148            IF(lwp) WRITE(numout,*)
149            IF(lwp) WRITE(numout,*) 'problem with dimensions'
150            IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta
151            IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta
152            nstop = nstop + 1
153         ENDIF
154         IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt
155      ELSE
156         iprint = 0
157      ENDIF
158
159
160      ! 3. Read SST if new day
161      ! -------------------------
162
163      ! Read daily SST
164
165      IF( ndaysst /= nday ) THEN
166         ndaysst = nday
167         iday = nday_year
168         
169         CALL flinget( numsst, 'sst', jpidta, jpjdta, 1, idy, iday,   &
170            iday, mig(1), nlci, mjg(1), nlcj, sst(1:nlci,1:nlcj) )
171         
172         IF ( kt == nit000 .AND. lwp ) THEN
173            WRITE(numout,*) ' '
174            WRITE(numout,*) ' read daily sea surface temperature ok'
175            WRITE(numout,*) ' '
176            WRITE(numout,*) ' Surface temp day: ', ndastp
177            CALL prihre(sst(1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout)
178         ENDIF
179         
180      ENDIF
181     
182      ! 2. At every time step compute temperature data
183      ! ----------------------------------------------
184     
185      DO jj = 1, jpj
186         DO ji = 1, jpi
187            ztgel = fzptn(ji,jj)
188            rclice(ji,jj,1) = tmask(ji,jj,1)
189            IF( sst(ji,jj) >= ztgel )   rclice(ji,jj,1) = 0.e0
190            rclice(ji,jj,2) = rclice(ji,jj,1)
191         END DO
192      END DO
193      IF( kt == nit000 .AND. lwp ) THEN
194         WRITE(numout,*)
195         WRITE(numout,*) 'Computed Ice cover rclice'
196         WRITE(numout,*)
197         WRITE(numout,*) 'Ice cover : '
198         CALL prihre( rclice(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
199      ENDIF
200     
201      ! Close the file
202      ! --------------
203     
204      IF( kt == nitend )   CALL flinclo(numsst)
205      CALL FLUSH(numout)
206     
207
208   END SUBROUTINE dta_sst
209
210#else
211   !!----------------------------------------------------------------------
212   !!   Default option :                                        NO SST data
213   !!----------------------------------------------------------------------
214
215   SUBROUTINE dta_sst( kt )
216      !!---------------------------------------------------------------------
217      !!                  ***  ROUTINE dta_sst  ***
218      !!                   
219      !! ** Purpose :   sea surface temperature data and update it
220      !!     at each time step.   ???
221      !!
222      !! ** Method  : - sst   = tn
223      !!              - rclice = 1. IF tn =< ztgel
224      !!
225      !! History :
226      !!        !  91-03  ()  Original code
227      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
228      !!----------------------------------------------------------------------
229      !! * Arguments
230      INTEGER, INTENT( in ) ::   kt      ! ocean timestep
231     
232      !! * Local declarations
233      INTEGER :: ji, jj
234      !!---------------------------------------------------------------------
235     
236      IF( kt == nit000 ) THEN
237         IF(lwp) WRITE(numout,*)
238         IF(lwp) WRITE(numout,*) 'dta_sst : No SST data'
239         IF(lwp) WRITE(numout,*) '~~~~~~~'
240      ENDIF
241     
242      ! 1. Update at each time step
243      ! ---------------------------
244
245      sst   (:,:)   = tn   (:,:,1)
246      rclice(:,:,1) = tmask(:,:,1)
247      DO jj = 1, jpj
248         DO ji = 1, jpi
249            IF( tn(ji,jj,1) >= fzptn(ji,jj) ) rclice(ji,jj,1) = 0.e0
250         END DO
251      END DO
252      rclice(:,:,2) = rclice(:,:,1)
253     
254   END SUBROUTINE dta_sst
255#endif
256
257   !!======================================================================
258END MODULE dtasst
Note: See TracBrowser for help on using the repository browser.