source: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

Last change on this file was 65, checked in by smasson, 12 years ago

bugfix for agrf, obc and xios
File size: 9.6 KB
Line 
1MODULE obcdta
2   !!======================================================================
3   !!                       ***  MODULE obcdta  ***
4   !! Open boundary data : read the data for the open boundaries.
5   !!======================================================================
6   !! History : 3.3  !  2010-12  ()        -              -
7   !!----------------------------------------------------------------------
8#if defined key_obc
9   !!------------------------------------------------------------------------------
10   !!   'key_obc'         :                                Open Boundary Conditions
11   !!------------------------------------------------------------------------------
12   !!   obc_dta           : read u, v, t, s data along each open boundary
13   !!------------------------------------------------------------------------------
14   USE obc_oce         ! ocean open boundary conditions
15   USE obc_par         ! ocean open boundary conditions
16   USE fldread         ! read input fields
17   USE in_out_manager  ! I/O logical units
18   USE lib_mpp         ! for ctl_stop
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC obc_dta      ! routines called by step.F90
24   PUBLIC obc_dta_bt   ! routines called by dynspg_ts.F90
25
26   TYPE(FLD), DIMENSION(:), ALLOCATABLE ::   sf_obc       !: structure:
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
29   !! $Id: obcdta.F90 188 2010-12-28 21:15:19Z rblod $
30   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE obc_dta( kt )
35      !!---------------------------------------------------------------------------
36      !!                      ***  SUBROUTINE obc_dta  ***
37      !!                   
38      !! ** Purpose :   read the data for the open boundaries.
39      !!---------------------------------------------------------------------------
40      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
41      !!---------------------------------------------------------------------
42      !     
43      IF( lk_obc ) THEN
44
45      IF( kt == nit000 )  CALL obc_dta_init()
46      !
47      IF ( lp_obc_east ) THEN
48         CALL fld_read( kt, 1, sf_obc(1:4) )
49         ufoe(:,:) = sf_obc(1)%fnow(:,:,1)
50         vfoe(:,:) = sf_obc(2)%fnow(:,:,1)
51         tfoe(:,:) = sf_obc(3)%fnow(:,:,1)
52         sfoe(:,:) = sf_obc(4)%fnow(:,:,1)
53      ENDIF
54 
55      IF ( lp_obc_west ) THEN
56         CALL fld_read( kt, 1, sf_obc(5:8) )
57         ufow(:,:) = sf_obc(5)%fnow(:,:,1)
58         vfow(:,:) = sf_obc(6)%fnow(:,:,1)
59         tfow(:,:) = sf_obc(7)%fnow(:,:,1)
60         sfow(:,:) = sf_obc(8)%fnow(:,:,1)
61      ENDIF
62 
63      IF ( lp_obc_north ) THEN
64         CALL fld_read( kt, 1, sf_obc(9:12) )
65         ufon(:,:) = sf_obc( 9)%fnow(:,:,1)
66         vfon(:,:) = sf_obc(10)%fnow(:,:,1)
67         tfon(:,:) = sf_obc(11)%fnow(:,:,1)
68         sfon(:,:) = sf_obc(12)%fnow(:,:,1)
69      ENDIF
70 
71      IF ( lp_obc_south ) THEN
72         CALL fld_read( kt, 1, sf_obc(13:16) )
73         ufos(:,:) = sf_obc(13)%fnow(:,:,1)
74         vfos(:,:) = sf_obc(14)%fnow(:,:,1)
75         tfos(:,:) = sf_obc(15)%fnow(:,:,1)
76         sfos(:,:) = sf_obc(16)%fnow(:,:,1)
77      ENDIF
78
79      ENDIF
80 
81   END SUBROUTINE obc_dta
82
83
84# if defined key_dynspg_ts || defined key_dynspg_exp
85   SUBROUTINE obc_dta_bt( kt, kbt )
86      INTEGER,INTENT(in) :: kt
87      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index
88      !!---------------------------------------------------------------------------
89      !!                      ***  SUBROUTINE obc_dta  ***
90      !!
91      !! ** Purpose :   time interpolation of barotropic data for time-splitting scheme
92      !!                Data at the boundary must be in m2/s
93   END SUBROUTINE obc_dta_bt
94
95# else
96   !!-----------------------------------------------------------------------------
97   !!   Default option
98   !!-----------------------------------------------------------------------------
99   SUBROUTINE obc_dta_bt ( kt, kbt )       ! Empty routine
100      INTEGER,INTENT(in) :: kt
101      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index
102      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt
103      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt
104   END SUBROUTINE obc_dta_bt
105# endif
106
107
108   SUBROUTINE obc_dta_init
109      !!---------------------------------------------------------------------------
110      !!                      ***  SUBROUTINE obc_dta  ***
111      !!                   
112      !! ** Purpose :   initialization of ....
113      !!
114      !! ** Method  : - read the obc namobc_dta namelist
115      !!
116      !! ** Action  : - read parameters
117      !!---------------------------------------------------------------------------
118      INTEGER :: ifpr,ierror
119      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files
120      TYPE(FLD_N), DIMENSION(4) ::   sn_obce, sn_obcw, sn_obcn, sn_obcs  ! array of namelist informations on the obc to read
121      NAMELIST/namobc_dta/ sn_obce, sn_obcw, sn_obcn, sn_obcs
122      !!---------------------------------------------------------------------
123      ALLOCATE(sf_obc(16), stat = ierror)
124      IF( ierror > 0 ) CALL ctl_stop('Pb of alloction of sf_obc(16) obc_dta_init')
125      !
126      ! set file information (default values)
127      cn_dir = './'       ! directory in which the model is executed
128      !
129      ! (NB: frequency positive => hours, negative => months)
130      !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
131      !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
132      sn_obce(1) = FLD_N( 'obc_east', 120   ,   'vozocrtx'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
133      sn_obce(2) = FLD_N( 'obc_east', 120   ,   'vomecrty'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
134      sn_obce(3) = FLD_N( 'obc_east', 120   ,   'votemper'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
135      sn_obce(4) = FLD_N( 'obc_east', 120   ,   'vosaline'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
136         
137      sn_obcw(1) = FLD_N( 'obc_west', 120   ,   'vozocrtx'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
138      sn_obcw(2) = FLD_N( 'obc_west', 120   ,   'vomecrty'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
139      sn_obcw(3) = FLD_N( 'obc_west', 120   ,   'votemper'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
140      sn_obcw(4) = FLD_N( 'obc_west', 120   ,   'vosaline'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
141         
142      sn_obcn(1) = FLD_N( 'obc_north', 120  ,   'vozocrtx'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
143      sn_obcn(2) = FLD_N( 'obc_north', 120  ,   'vomecrty'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
144      sn_obcn(3) = FLD_N( 'obc_north', 120  ,   'votemper'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
145      sn_obcn(4) = FLD_N( 'obc_north', 120  ,   'vosaline'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
146         
147      sn_obcs(1) = FLD_N( 'obc_south', 120  ,   'vozocrtx'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
148      sn_obcs(2) = FLD_N( 'obc_south', 120  ,   'vomecrty'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
149      sn_obcs(3) = FLD_N( 'obc_south', 120  ,   'votemper'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
150      sn_obcs(4) = FLD_N( 'obc_south', 120  ,   'vosaline'   ,   .TRUE.   , .FALSE. ,   'yearly'  , ''       , ''       )
151      !
152      REWIND( numnam )                          ! read in namlist namobc_dta
153      READ  ( numnam, namobc_dta )
154         
155      IF ( lp_obc_east ) THEN
156         DO ifpr= 1, 4
157            ALLOCATE( sf_obc(ifpr)%fnow(jpj,jpk,1) )
158            IF( sn_obce(ifpr)%ln_tint ) ALLOCATE( sf_obc(ifpr)%fdta(jpj,jpk,1,2) )
159         END DO
160         CALL fld_fill( sf_obc(1:4), sn_obce, cn_dir, 'obc_dta_init', 'fill east OBC', 'namobc_dta' )
161      ENDIF
162 
163      IF ( lp_obc_west ) THEN
164         DO ifpr= 5, 8
165            ALLOCATE( sf_obc(ifpr)%fnow(jpj,jpk,1) )
166            IF( sn_obcw(ifpr-4)%ln_tint ) ALLOCATE( sf_obc(ifpr)%fdta(jpj,jpk,1,2) )
167         END DO
168         CALL fld_fill( sf_obc(5:8), sn_obcw, cn_dir, 'obc_dta_init', 'fill west OBC', 'namobc_dta' )
169      ENDIF
170 
171      IF ( lp_obc_north ) THEN
172         DO ifpr= 9, 12
173            ALLOCATE( sf_obc(ifpr)%fnow(jpi,jpk,1) )
174            IF( sn_obcn(ifpr-8)%ln_tint ) ALLOCATE( sf_obc(ifpr)%fdta(jpi,jpk,1,2) )
175         END DO
176         CALL fld_fill( sf_obc(9:12), sn_obcn, cn_dir, 'obc_dta_init', 'fill north OBC', 'namobc_dta' )
177      ENDIF
178 
179      IF ( lp_obc_south ) THEN
180         DO ifpr= 13, 16
181            ALLOCATE( sf_obc(ifpr)%fnow(jpi,jpk,1) )
182            IF( sn_obcs(ifpr-12)%ln_tint ) ALLOCATE( sf_obc(ifpr)%fdta(jpi,jpk,1,2) )
183         END DO
184         CALL fld_fill( sf_obc(13:16), sn_obcs, cn_dir, 'obc_dta_init', 'fill south OBC', 'namobc_dta' )
185      ENDIF
186
187   END SUBROUTINE obc_dta_init
188
189#else
190      !!------------------------------------------------------------------------------
191      !!   default option:           Dummy module          NO Open Boundary Conditions
192      !!------------------------------------------------------------------------------
193   CONTAINS
194      SUBROUTINE obc_dta( kt )             ! Dummy routine
195         INTEGER, INTENT (in) :: kt
196         WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt
197      END SUBROUTINE obc_dta
198#endif
199
200   !!======================================================================
201   END MODULE obcdta
Note: See TracBrowser for help on using the repository browser.