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

Last change on this file since 18 was 9, checked in by cholod, 12 years ago

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