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.
cpl_oasis4.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta
  • Property svn:keywords set to Id
File size: 22.0 KB
Line 
1MODULE cpl_oasis4
2   !!======================================================================
3   !!                    ***  MODULE cpl_oasis  ***
4   !! Coupled O/A : coupled ocean-atmosphere case using OASIS4
5   !!=====================================================================
6   !! History :   
7   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code
8   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision
9   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
10   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
11   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
12   !!   " "  !  06-01  (W. Park) modification of physical part
13   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
14   !!   " "  !  2010   (E. Maisonnave and S. Masson) complete rewrite
15   !!----------------------------------------------------------------------
16#if defined key_oasis4
17   !!----------------------------------------------------------------------
18   !!   'key_oasis4'                    coupled Ocean/Atmosphere via OASIS4
19   !!----------------------------------------------------------------------
20   !!----------------------------------------------------------------------
21   !!   cpl_prism_init     : initialization of coupled mode communication
22   !!   cpl_prism_define   : definition of grid and fields
23   !!   cpl_prism_snd     : snd out fields in coupled mode
24   !!   cpl_prism_rcv     : receive fields in coupled mode
25   !!   cpl_prism_update_time   : update date sent to Oasis
26   !!   cpl_prism_finalize : finalize the coupled mode communication
27   !!----------------------------------------------------------------------
28   USE prism              ! OASIS4 prism module
29   USE par_oce                      ! ocean parameters
30   USE dom_oce                      ! ocean space and time domain
31   USE domwri                       ! ocean space and time domain
32   USE in_out_manager               ! I/O manager
33   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
34
35   IMPLICIT NONE
36   PRIVATE
37!
38!   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.    ! coupled flag
39   INTEGER                    :: ncomp_id           ! id returned by prism_init_comp
40   INTEGER                    :: nerror             ! return error code
41   INTEGER, PUBLIC            :: OASIS_Rcv  = 1     ! return code if received field
42   INTEGER, PUBLIC            :: OASIS_idle = 0     ! return code if nothing done by oasis
43
44   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
45   
46   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
47      LOGICAL            ::   laction   ! To be coupled or not
48      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
49      CHARACTER(len = 1) ::   clgrid    ! Grid type 
50      REAL(wp)           ::   nsgn      ! Control of the sign change
51      INTEGER            ::   nid       ! Id of the field
52   END TYPE FLD_CPL
53
54   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
55
56   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
57
58   TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
59   TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
60
61
62   !! Routine accessibility
63   PUBLIC cpl_prism_init
64   PUBLIC cpl_prism_define
65   PUBLIC cpl_prism_snd
66   PUBLIC cpl_prism_rcv
67   PUBLIC cpl_prism_update_time
68   PUBLIC cpl_prism_finalize
69
70   !!----------------------------------------------------------------------
71   !!   OPA 9.0 , LOCEAN-IPSL (2006)
72   !! $Header$
73   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
74   !!----------------------------------------------------------------------
75
76CONTAINS
77
78   SUBROUTINE cpl_prism_init (kl_comm) 
79
80      !!-------------------------------------------------------------------
81      !!             ***  ROUTINE cpl_prism_init  ***
82      !!
83      !! ** Purpose :   Initialize coupled mode communication for ocean
84      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
85      !!
86      !! ** Method  :   OASIS4 MPI communication
87      !!--------------------------------------------------------------------
88      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
89      !
90     
91      CALL prism_init( 'nemo', nerror )
92
93      !------------------------------------------------------------------
94      ! 2nd Initialize the PRISM system for the component
95      !------------------------------------------------------------------
96      CALL prism_init_comp( ncomp_id, 'oceanx', nerror )
97      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp' )
98
99      !------------------------------------------------------------------
100      ! 3rd Get an MPI communicator fr OPA local communication
101      !------------------------------------------------------------------
102      CALL prism_get_localcomm( ncomp_id, kl_comm, nerror )
103      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_get_localcomm' )
104
105
106   END SUBROUTINE cpl_prism_init
107
108
109   SUBROUTINE cpl_prism_define (krcv, ksnd)
110
111      !!-------------------------------------------------------------------
112      !!             ***  ROUTINE cpl_prism_define  ***
113      !!
114      !! ** Purpose :   Define grid and field information for ocean
115      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
116      !!
117      !! ** Method  :   OASIS4 MPI communication
118      !!--------------------------------------------------------------------
119      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields
120      !
121      INTEGER, DIMENSION(4)      :: igrid     ! ids returned by prism_def_grid
122      INTEGER, DIMENSION(4)      :: iptid     ! ids returned by prism_set_points
123
124      INTEGER, DIMENSION(4)      :: imskid  ! ids returned by prism_set_mask
125      INTEGER, DIMENSION(4)      :: iishift     !
126      INTEGER, DIMENSION(4)      :: ijshift    !
127      INTEGER, DIMENSION(4)      :: iioff     !
128      INTEGER, DIMENSION(4)      :: ijoff    !
129      INTEGER, DIMENSION(4)      :: itmp    !
130      INTEGER, DIMENSION(1,3)    :: iextent    !
131      INTEGER, DIMENSION(1,3)    :: ioffset    !
132
133
134      INTEGER                    :: ishape(2,3)     ! shape of arrays passed to PSMILe
135      INTEGER                    :: data_type      ! data type of transients
136
137
138      LOGICAL                    :: new_points
139      LOGICAL                    :: new_mask
140      LOGICAL                    :: llmask(jpi,jpj,1)
141
142      INTEGER                    :: ji, jj, jg, jc     ! local loop indicees
143      INTEGER                    :: ii,ij     ! index
144      INTEGER, DIMENSION(1)      :: ind     ! index
145
146      CHARACTER(len=32)          :: clpt_name     ! name of the grid points
147      CHARACTER(len=7)           :: cltxt 
148      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points
149
150      REAL(kind=wp), DIMENSION(jpi,jpj,4)  :: zclo, zcla
151      REAL(kind=wp), DIMENSION(jpi,jpj  )  :: zlon, zlat
152
153      TYPE(PRISM_Time_struct)    :: tmpdate
154      INTEGER                    :: idate_incr      ! date increment
155      !!
156      !!--------------------------------------------------------------------
157
158      IF(lwp) WRITE(numout,*)
159      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
160      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
161      IF(lwp) WRITE(numout,*)
162
163      !
164      ! ... Allocate memory for data exchange
165      !
166      ALLOCATE( exfld(nlei-nldi+1, nlej-nldj+1, 1), stat = nerror )
167      IF ( nerror > 0 ) THEN
168         CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld' )
169         RETURN
170      ENDIF
171
172
173      ! -----------------------------------------------------------------
174      ! ... Define the shape of the valid region without the halo and overlaps between cpus
175      !     For serial configuration (key_mpp_mpi not being active)
176      !     nl* is set to the global values 1 and jp*glo.
177      ! -----------------------------------------------------------------
178
179      ishape(:,1) = (/ 1, nlei-nldi+1 /)
180      ishape(:,2) = (/ 1, nlej-nldj+1 /)
181      ishape(:,3) = (/ 1,           1 /)
182         
183      DO ji = 1, 4
184         CALL prism_def_grid( igrid(ji), 'orca'//clgrd(ji), ncomp_id, ishape, PRISM_irrlonlat_regvrt, nerror )
185         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
186            &                                                        'Failure in prism_def_grid of '//clgrd(jg)//'-point' )
187      END DO
188     
189      ! -----------------------------------------------------------------
190      ! ... Define the partition
191      ! -----------------------------------------------------------------
192     
193      iextent(1,:) = (/    nlei-nldi+1,    nlej-nldj+1, 1 /)
194      ioffset(1,:) = (/ nldi-1+nimpp-1, nldj-1+njmpp-1, 0 /)
195     
196      DO ji = 1, 4
197         CALL prism_def_partition( igrid(ji), 1, ioffset, iextent, nerror )
198         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
199            &                                                        'Failure in prism_def_partition of '//clgrd(jg)//'-point' )
200      END DO
201
202      ! -----------------------------------------------------------------
203      ! ... Define the elements, i.e. specify the corner points for each
204      !     volume element. In case OPA runs on level coordinates (regular
205      !     in the vertical) we only need to give the 4 horizontal corners
206      !     for a volume element plus the vertical position of the upper
207      !     and lower face. Nevertheless the volume element has 8 corners.
208      ! -----------------------------------------------------------------
209     
210      iioff(:) = (/0,1,0,1/)
211      ijoff(:) = (/0,0,1,1/) 
212      iishift(:) = (/0,1,1,0/)
213      ijshift(:) = (/0,0,1,1/)
214
215      DO jg = 1, 4    ! ... the t,u,v,f-points
216
217         cltxt = clgrd(jg)//'-point'
218         
219         ! -----------------------------------------------------------------
220         ! ... Convert OPA masks to logicals and define the masks
221         ! -----------------------------------------------------------------
222         SELECT CASE( jg ) 
223         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1)  ) == 1.
224         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1)  ) == 1.
225         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1)  ) == 1.
226         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1)  ) == 1.
227!         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1) * dom_uniq('T') ) == 1.
228!         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1) * dom_uniq('U') ) == 1.
229!         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1) * dom_uniq('V') ) == 1.
230!         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1) * dom_uniq('F') ) == 1.
231         END SELECT
232         CALL prism_set_mask( imskid(jg), igrid(jg), ishape, llmask(nldi:nlei, nldj:nlej, 1), .TRUE., nerror )
233         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_mask for '//cltxt )
234
235         ! -----------------------------------------------------------------
236         ! ... Define the corners
237         ! -----------------------------------------------------------------
238         SELECT CASE( jg ) 
239         CASE(1)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
240         CASE(2)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
241         CASE(3)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:) 
242         CASE(4)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
243         END SELECT
244
245         DO jc = 1, 4   ! corner number (anti-clockwise, starting from the bottom left corner)
246            DO jj = 2, jpjm1
247               DO ji = 2, jpim1   ! NO vector opt.
248                  ii = ji-1 + iioff(jg) + iishift(jc)
249                  ij = jj-1 + ijoff(jg) + ijshift(jc)
250                  zclo(ji,jj,jc) = zlon(ii,ij)
251                  zcla(ji,jj,jc) = zlat(ii,ij)
252               END DO
253            END DO
254            CALL lbc_lnk( zclo(:,:,jc), clgrd(jg), 1. )   ;   CALL lbc_lnk( zcla(:,:,jc), clgrd(jg), 1. )
255         END DO
256
257         CALL prism_set_corners( igrid(jg), 8, ishape, zclo(nldi:nlei, nldj:nlej,:),   &
258            &                                          zcla(nldi:nlei, nldj:nlej,:), RESHAPE( (/-1.,1./), (/1,2/) ), nerror )
259         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_corners of '//cltxt )   
260
261         ! -----------------------------------------------------------------
262         ! ... Define the center points
263         ! -----------------------------------------------------------------
264         SELECT CASE( jg ) 
265         CASE(1)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
266         CASE(2)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:)
267         CASE(3)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
268         CASE(4)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
269         END SELECT
270
271         CALL prism_set_points ( iptid(jg), cltxt, igrid(jg), ishape, zlon(nldi:nlei, nldj:nlej),   &
272         &                                                            zlat(nldi:nlei, nldj:nlej), (/0./), .TRUE., nerror )
273         IF( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_points '//cltxt )
274
275      END DO
276
277      ! ... Announce send variables.
278      !
279      DO ji = 1, ksnd
280         IF ( ssnd(ji)%laction ) THEN
281           
282            itmp(:) = 0
283            WHERE( clgrd == ssnd(ji)%clgrid  ) itmp = 1
284            ind(:) = maxloc( itmp )
285            WRITE(6,*) ' grid for field ', ind(1), ssnd(ji)%clname
286             ind(1) = 1
287
288            CALL prism_def_var( ssnd(ji)%nid, ssnd(ji)%clname, igrid(ind(1)), iptid(ind(1)),  imskid(ind(1)), (/ 3, 0/),   &
289               &                ishape, PRISM_Double_Precision, nerror )
290            IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(ji)%nid, 'cpl_prism_define',   &
291               &                                               'Failure in prism_def_var for '//TRIM(ssnd(ji)%clname))
292
293         ENDIF
294      END DO
295      !
296      ! ... Announce received variables.
297      !
298      DO ji = 1, krcv
299         IF ( srcv(ji)%laction ) THEN
300
301            itmp(:) = 0
302            WHERE( clgrd == srcv(ji)%clgrid  ) itmp = 1
303            ind(:) = maxloc( itmp )
304            WRITE(6,*) ' grid for field ', ind(1), srcv(ji)%clname
305             ind(1) = 1
306 
307            CALL prism_def_var( srcv(ji)%nid, srcv(ji)%clname, igrid(ind(1)), iptid(ind(1)), imskid(ind(1)), (/ 3, 0/),   &
308               &                ishape, PRISM_Double_Precision, nerror )
309            IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(ji)%nid, 'cpl_prism_define',   &
310               &                                               'Failure in prism_def_var for '//TRIM(srcv(ji)%clname))
311
312         ENDIF
313      END DO
314     
315      !------------------------------------------------------------------
316      ! End of definition phase
317      !------------------------------------------------------------------
318     
319      CALL prism_enddef( nerror )
320      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
321     
322   END SUBROUTINE cpl_prism_define
323   
324   
325   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
326
327      !!---------------------------------------------------------------------
328      !!              ***  ROUTINE cpl_prism_snd  ***
329      !!
330      !! ** Purpose : - At each coupling time-step,this routine sends fields
331      !!      like sst or ice cover to the coupler or remote application.
332      !!----------------------------------------------------------------------
333      !! * Arguments
334      !!
335      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
336      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
337      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
338      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
339      !!
340      !!
341      !!--------------------------------------------------------------------
342      !
343      ! snd data to OASIS4
344      !
345      exfld(:,:,1) = pdata(nldi:nlei, nldj:nlej)
346      CALL prism_put( ssnd(kid)%nid, date, date_bound, exfld, kinfo, nerror )
347      IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(kid)%nid, 'cpl_prism_snd',   &
348         &                                               'Failure in prism_put for '//TRIM(ssnd(kid)%clname) )
349
350      IF ( ln_ctl ) THEN       
351         IF ( kinfo >= PRISM_Cpl     .OR. kinfo == PRISM_Rst .OR.   &
352            & kinfo == PRISM_RstTimeop ) THEN
353            WRITE(numout,*) '****************'
354            WRITE(numout,*) 'prism_put: Outgoing ', ssnd(kid)%clname
355            WRITE(numout,*) 'prism_put: ivarid ', ssnd(kid)%nid
356            WRITE(numout,*) 'prism_put:  kstep ', kstep
357            WRITE(numout,*) 'prism_put:   info ', kinfo
358            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
359            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
360            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
361            WRITE(numout,*) '****************'
362        ENDIF
363     ENDIF
364    END SUBROUTINE cpl_prism_snd
365
366
367   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
368
369      !!---------------------------------------------------------------------
370      !!              ***  ROUTINE cpl_prism_rcv  ***
371      !!
372      !! ** Purpose : - At each coupling time-step,this routine receives fields
373      !!      like stresses and fluxes from the coupler or remote application.
374      !!----------------------------------------------------------------------
375      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
376      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
377      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
378      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
379      !!
380      LOGICAL                :: llaction
381      !!--------------------------------------------------------------------
382      !
383      ! receive local data from OASIS4 on every process
384      !
385      CALL prism_get( srcv(kid)%nid, date, date_bound, exfld, kinfo, nerror )         
386      IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(kid)%nid, 'cpl_prism_rcv',   &
387         &                                               'Failure in prism_get for '//TRIM(srcv(kid)%clname) )
388
389      WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
390      call flush(numout)
391      llaction = .false.
392      IF( kinfo == PRISM_Cpl )  llaction = .TRUE.
393
394      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
395
396      IF ( llaction ) THEN
397
398         kinfo = OASIS_Rcv
399         pdata(nldi:nlei, nldj:nlej) = exfld(:,:,1)
400         
401         !--- Fill the overlap areas and extra hallows (mpp)
402         !--- check periodicity conditions (all cases)
403         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
404         
405         IF ( ln_ctl ) THEN       
406            WRITE(numout,*) '****************'
407            WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
408            WRITE(numout,*) 'prism_get: ivarid '  , srcv(kid)%nid
409            WRITE(numout,*) 'prism_get:   kstep', kstep
410            WRITE(numout,*) 'prism_get:   info ', kinfo
411            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
412            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
413            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
414            WRITE(numout,*) '****************'
415         ENDIF
416
417      ELSE
418         kinfo = OASIS_idle     
419      ENDIF
420
421
422   END SUBROUTINE cpl_prism_rcv
423
424
425   SUBROUTINE cpl_prism_finalize
426
427      !!---------------------------------------------------------------------
428      !!              ***  ROUTINE cpl_prism_finalize  ***
429      !!
430      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
431      !!      called explicitly before cpl_prism_init it will also close
432      !!      MPI communication.
433      !!----------------------------------------------------------------------
434
435      DEALLOCATE(exfld)
436      CALL prism_terminate ( nerror )         
437
438   END SUBROUTINE cpl_prism_finalize
439
440   SUBROUTINE cpl_prism_update_time(kt)
441
442      !!---------------------------------------------------------------------
443      !!              ***  ROUTINE cpl_prism_update_time  ***
444      !!
445      !! ** Purpose : - Increment date with model timestep
446      !!      called explicitly at the end of each timestep
447      !!----------------------------------------------------------------------
448
449      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
450
451      TYPE(PRISM_Time_struct)    :: tmpdate
452      INTEGER                    :: idate_incr     ! date increment
453
454
455      IF( kt == nit000 ) THEN
456      !
457      ! Define the actual date
458      !
459      ! date is determined by adding days since beginning of the run to the corresponding initial date.
460      ! Note that OPA internal info about the start date of the experiment is bypassed.
461      ! Instead we rely sololy on the info provided by the SCC.xml file.
462      !
463         date = PRISM_Jobstart_date
464         !
465         !
466         ! lower/upper bound is determined by adding half a time step
467         !
468         idate_incr = 0.5 * NINT ( rdttra(1) )
469         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate, -idate_incr, nerror )   ;   date_bound(1) = tmpdate
470         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate,  idate_incr, nerror )   ;   date_bound(2) = tmpdate
471
472      ELSE
473      !
474      ! Date update
475      !
476         idate_incr  = rdttra(1)
477         CALL PRISM_calc_newdate( date, idate_incr, nerror )
478         date_bound(1) = date_bound(2)
479         tmpdate = date_bound(2)
480         CALL PRISM_calc_newdate( tmpdate, idate_incr, nerror )
481         date_bound(2) = tmpdate
482
483      END IF
484
485   END SUBROUTINE cpl_prism_update_time
486
487#endif
488
489END MODULE cpl_oasis4
Note: See TracBrowser for help on using the repository browser.