MODULE obcdta !!====================================================================== !! *** MODULE obcdta *** !! Open boundary data : read the data for the unstructured open boundaries. !!====================================================================== !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code !! - ! 2007-01 (D. Storkey) Update to use IOM module !! - ! 2007-07 (D. Storkey) add obc_dta_fla !! 3.0 ! 2008-04 (NEMO team) add in the reference version !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions !! 3.4 ???????????????? !!---------------------------------------------------------------------- #if defined key_obc !!---------------------------------------------------------------------- !! 'key_obc' Open Boundary Conditions !!---------------------------------------------------------------------- !! obc_dta : read external data along open boundaries from file !! obc_dta_init : initialise arrays etc for reading of external data !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE obc_oce ! ocean open boundary conditions USE obctides ! tidal forcing at boundaries USE fldread ! read input fields USE iom ! IOM library USE in_out_manager ! I/O logical units #if defined key_lim2 USE ice_2 #endif IMPLICIT NONE PRIVATE PUBLIC obc_dta ! routine called by step.F90 and dynspg_ts.F90 PUBLIC obc_dta_init ! routine called by nemogcm.F90 INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_obc_fld ! Number of fields to update for each boundary set. INTEGER :: nb_obc_fld_sum ! Total number of fields to update for all boundary sets. TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read) TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap !!---------------------------------------------------------------------- !! NEMO/OPA 3.3 , NEMO Consortium (2010) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE obc_dta( kt, jit ) !!---------------------------------------------------------------------- !! *** SUBROUTINE obc_dta *** !! !! ** Purpose : Update external data for open boundary conditions !! !! ** Method : Use fldread.F90 !! !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) !! INTEGER :: ib_obc, jfld, jstart, jend ! local indices INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts !! !!--------------------------------------------------------------------------- ! for nn_dtactl = 0, initialise data arrays once for all ! from initial conditions !------------------------------------------------------- IF( kt .eq. 1 .and. .not. PRESENT(jit) ) THEN DO ib_obc = 1, nb_obc IF( nn_dtactl(ib_obc) .eq. 0 ) THEN !!! TO BE DONE !!! ENDIF ENDDO ENDIF ! for nn_dtactl = 1, update external data from files !--------------------------------------------------- jstart = 1 DO ib_obc = 1, nb_obc IF( nn_dtactl(ib_obc) .eq. 1 ) THEN IF( PRESENT(jit) ) THEN ! Update barotropic boundary conditions only ! jit is optional argument for fld_read IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN jend = jstart + 2 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit ) ENDIF ELSE jend = jstart + nb_obc_fld(ib_obc) - 1 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend ), map=nbmap_ptr(jstart:jend), timeshift=1 ) ENDIF jstart = jend+1 END IF ! nn_dtactl(ib_obc) = 1 END DO ! ib_obc END SUBROUTINE obc_dta SUBROUTINE obc_dta_init !!---------------------------------------------------------------------- !! *** SUBROUTINE obc_dta_init *** !! !! ** Purpose : Initialise arrays for reading of external data !! for open boundary conditions !! !! ** Method : Use fldread.F90 !! !!---------------------------------------------------------------------- INTEGER :: ib_obc, jfld, jstart, jend, ierror ! local indices !! CHARACTER(len=100) :: cn_dir ! Root directory for location of data files CHARACTER(len=100), DIMENSION(nb_obc) :: cn_dir_array ! Root directory for location of data files INTEGER :: ilen_global ! Max length required for global obc dta arrays INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays INTEGER, ALLOCATABLE, DIMENSION(:) :: iobc ! obc set for a particular jfld INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read #if defined key_lim2 TYPE(FLD_N) :: bn_frld, bn_hicif, bn_hsnif ! #endif NAMELIST/namobc_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d #if defined key_lim2 NAMELIST/namobc_dta/ bn_frld, bn_hicif, bn_hsnif #endif !!--------------------------------------------------------------------------- ! Work out how many fields there are to read in and allocate arrays ! ----------------------------------------------------------------- ALLOCATE( nb_obc_fld(nb_obc) ) nb_obc_fld(:) = 0 DO ib_obc = 1, nb_obc IF( nn_dtactl(ib_obc) .eq. 1 ) THEN IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 ENDIF IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 ENDIF IF( nn_tra(ib_obc) .gt. 0 ) THEN nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 ENDIF #if defined key_lim2 IF( nn_ice_lim2(ib_obc) .gt. 0 ) THEN nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 ENDIF #endif ENDIF ENDDO nb_obc_fld_sum = SUM( nb_obc_fld ) ALLOCATE( bf(nb_obc_fld_sum), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'obc_dta: unable to allocate bf structure' ) ; RETURN ENDIF ALLOCATE( blf_i(nb_obc_fld_sum), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'obc_dta: unable to allocate blf_i structure' ) ; RETURN ENDIF ALLOCATE( nbmap_ptr(nb_obc_fld_sum), STAT=ierror ) IF( ierror > 0 ) THEN CALL ctl_stop( 'obc_dta: unable to allocate nbmap_ptr structure' ) ; RETURN ENDIF ALLOCATE( ilen1(nb_obc_fld_sum), ilen3(nb_obc_fld_sum) ) ALLOCATE( iobc(nb_obc_fld_sum) ) ALLOCATE( igrid(nb_obc_fld_sum) ) ! Read namelists ! -------------- REWIND(numnam) jfld = 0 DO ib_obc = 1, nb_obc IF( nn_dtactl(ib_obc) .eq. 1 ) THEN ! set file information cn_dir = './' ! directory in which the model is executed ! ... default values (NB: frequency positive => hours, negative => months) ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! bn_ssh = FLD_N( 'obc_ssh' , 24 , 'sossheig' , .false. , .false. , 'yearly' , '' , '' ) bn_u2d = FLD_N( 'obc_vel2d_u' , 24 , 'vobtcrtx' , .false. , .false. , 'yearly' , '' , '' ) bn_v2d = FLD_N( 'obc_vel2d_v' , 24 , 'vobtcrty' , .false. , .false. , 'yearly' , '' , '' ) bn_u3d = FLD_N( 'obc_vel3d_u' , 24 , 'vozocrtx' , .false. , .false. , 'yearly' , '' , '' ) bn_v3d = FLD_N( 'obc_vel3d_v' , 24 , 'vomecrty' , .false. , .false. , 'yearly' , '' , '' ) bn_tem = FLD_N( 'obc_tem' , 24 , 'votemper' , .false. , .false. , 'yearly' , '' , '' ) bn_sal = FLD_N( 'obc_sal' , 24 , 'vosaline' , .false. , .false. , 'yearly' , '' , '' ) #if defined key_lim2 bn_frld = FLD_N( 'obc_frld' , 24 , 'ildsconc' , .false. , .false. , 'yearly' , '' , '' ) bn_hicif = FLD_N( 'obc_hicif' , 24 , 'iicethic' , .false. , .false. , 'yearly' , '' , '' ) bn_hsnif = FLD_N( 'obc_hsnif' , 24 , 'isnothic' , .false. , .false. , 'yearly' , '' , '' ) #endif ! Important NOT to rewind here. READ( numnam, namobc_dta ) cn_dir_array(ib_obc) = cn_dir nblen => idx_obc(ib_obc)%nblen nblenrim => idx_obc(ib_obc)%nblenrim ! Only read in necessary fields for this set. ! Important that barotropic variables come first. IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN jfld = jfld + 1 blf_i(jfld) = bn_ssh iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 jfld = jfld + 1 blf_i(jfld) = bn_u2d iobc(jfld) = ib_obc igrid(jfld) = 2 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 jfld = jfld + 1 blf_i(jfld) = bn_v2d iobc(jfld) = ib_obc igrid(jfld) = 3 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 ENDIF ! baroclinic velocities IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN jfld = jfld + 1 blf_i(jfld) = bn_u3d iobc(jfld) = ib_obc igrid(jfld) = 2 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = jpk jfld = jfld + 1 blf_i(jfld) = bn_v3d iobc(jfld) = ib_obc igrid(jfld) = 3 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = jpk ENDIF ! temperature and salinity IF( nn_tra(ib_obc) .gt. 0 ) THEN jfld = jfld + 1 blf_i(jfld) = bn_tem iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_tra(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = jpk jfld = jfld + 1 blf_i(jfld) = bn_sal iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_tra(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = jpk ENDIF #if defined key_lim2 ! sea ice IF( nn_tra(ib_obc) .gt. 0 ) THEN jfld = jfld + 1 blf_i(jfld) = bn_frld iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 jfld = jfld + 1 blf_i(jfld) = bn_hicif iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 jfld = jfld + 1 blf_i(jfld) = bn_hsnif iobc(jfld) = ib_obc igrid(jfld) = 1 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN ilen1(jfld) = nblen(igrid(jfld)) ELSE ilen1(jfld) = nblenrim(igrid(jfld)) ENDIF ilen3(jfld) = 1 ENDIF #endif ENDIF ! nn_dtactl .eq. 1 ENDDO ! ib_obc IF( jfld .ne. nb_obc_fld_sum ) THEN CALL ctl_stop( 'obc_dta: error in initialisation: jpfld .ne. nb_obc_fld_sum' ) ; RETURN ENDIF DO jfld = 1, nb_obc_fld_sum ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) nbmap_ptr(jfld)%ptr => idx_obc(iobc(jfld))%nbmap(:,igrid(jfld)) ENDDO ! fill bf with blf_i and control print !------------------------------------- jstart = 1 DO ib_obc = 1, nb_obc jend = jstart + nb_obc_fld(ib_obc) - 1 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_obc), 'obc_dta', 'open boundary conditions', 'namobc_dta' ) jstart = jend + 1 ENDDO ! Initialise local boundary data arrays ! nn_dtactl=0 : allocate space - will be filled from initial conditions later ! nn_dtactl=1 : point to "fnow" arrays !------------------------------------- jfld = 0 DO ib_obc=1, nb_obc nblen => idx_obc(ib_obc)%nblen nblenrim => idx_obc(ib_obc)%nblenrim IF( nn_dtactl(ib_obc) .eq. 0 ) THEN ! nn_dtactl = 0 ! Allocate space !--------------- IF (nn_dyn2d(ib_obc) .gt. 0) THEN IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN ilen1(1) = nblen(1) ilen1(2) = nblen(2) ilen1(3) = nblen(3) ELSE ilen1(1) = nblenrim(1) ilen1(2) = nblenrim(2) ilen1(3) = nblenrim(3) ENDIF ALLOCATE( dta_obc(ib_obc)%ssh(ilen1(1)) ) ALLOCATE( dta_obc(ib_obc)%u2d(ilen1(2)) ) ALLOCATE( dta_obc(ib_obc)%v2d(ilen1(3)) ) ENDIF IF (nn_dyn3d(ib_obc) .gt. 0) THEN IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN ilen1(2) = nblen(2) ilen1(3) = nblen(3) ELSE ilen1(2) = nblenrim(2) ilen1(3) = nblenrim(3) ENDIF ALLOCATE( dta_obc(ib_obc)%u3d(ilen1(2),jpk) ) ALLOCATE( dta_obc(ib_obc)%v3d(ilen1(3),jpk) ) ENDIF IF (nn_tra(ib_obc) .gt. 0) THEN IF( nn_tra(ib_obc) .eq. jp_frs ) THEN ilen1(1) = nblen(1) ELSE ilen1(1) = nblenrim(1) ENDIF ALLOCATE( dta_obc(ib_obc)%tem(ilen1(1),jpk) ) ALLOCATE( dta_obc(ib_obc)%sal(ilen1(1),jpk) ) ENDIF #if defined key_lim2 IF (nn_ice_lim2(ib_obc) .gt. 0) THEN IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN ilen1(1) = nblen(igrid(jfld)) ELSE ilen1(1) = nblenrim(igrid(jfld)) ENDIF ALLOCATE( dta_obc(ib_obc)%ssh(ilen1(1)) ) ALLOCATE( dta_obc(ib_obc)%u2d(ilen1(1)) ) ALLOCATE( dta_obc(ib_obc)%v2d(ilen1(1)) ) ENDIF #endif ELSE ! nn_dtactl = 1 ! Set boundary data arrays to point to relevant "fnow" arrays !----------------------------------------------------------- IF (nn_dyn2d(ib_obc) .gt. 0) THEN jfld = jfld + 1 dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1) jfld = jfld + 1 dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1) jfld = jfld + 1 dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1) ENDIF IF (nn_dyn3d(ib_obc) .gt. 0) THEN jfld = jfld + 1 dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:) jfld = jfld + 1 dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:) ENDIF IF (nn_tra(ib_obc) .gt. 0) THEN jfld = jfld + 1 dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:) jfld = jfld + 1 dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:) ENDIF #if defined key_lim2 IF (nn_ice_lim2(ib_obc) .gt. 0) THEN jfld = jfld + 1 dta_obc(ib_obc)%frld => bf(jfld)%fnow(:,1,1) jfld = jfld + 1 dta_obc(ib_obc)%hicif => bf(jfld)%fnow(:,1,1) jfld = jfld + 1 dta_obc(ib_obc)%hsnif => bf(jfld)%fnow(:,1,1) ENDIF #endif ENDIF ! nn_dtactl .eq. 0 ENDDO ! ib_obc END SUBROUTINE obc_dta_init #else !!---------------------------------------------------------------------- !! Dummy module NO Open Boundary Conditions !!---------------------------------------------------------------------- CONTAINS SUBROUTINE obc_dta( kt, jit ) ! Empty routine WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt END SUBROUTINE obc_dta SUBROUTINE obc_dta_init() ! Empty routine WRITE(*,*) 'obc_dta_init: You should not have seen this print! error?' END SUBROUTINE obc_dta_init #endif !!============================================================================== END MODULE obcdta