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.
Changeset 5682 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90 – NEMO

Ignore:
Timestamp:
2015-08-12T17:46:45+02:00 (9 years ago)
Author:
mattmartin
Message:

OBS simplification changes committed to branch after running SETTE tests to make sure we get the same results as the trunk for ORCA2_LIM_OBS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    • Property svn:keywords set to Id
    r4990 r5682  
    3636   PUBLIC   sbc_ssm        ! called by sbc 
    3737 
    38    CHARACTER(len=100)   ::   cn_dir     = './'    !: Root directory for location of ssm files 
    39    LOGICAL              ::   ln_3d_uv   = .true.  !: specify whether input velocity data is 3D 
    40    INTEGER  , SAVE      ::   nfld_3d 
    41    INTEGER  , SAVE      ::   nfld_2d 
    42  
    43    INTEGER  , PARAMETER ::   jpfld_3d = 4   ! maximum number of files to read 
    44    INTEGER  , PARAMETER ::   jpfld_2d = 1   ! maximum number of files to read 
    45    INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    46    INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    47    INTEGER  , SAVE      ::   jf_usp         ! index of u velocity component 
    48    INTEGER  , SAVE      ::   jf_vsp         ! index of v velocity component 
    49    INTEGER  , SAVE      ::   jf_ssh         ! index of sea surface height 
     38   CHARACTER(len=100)   ::   cn_dir        !: Root directory for location of ssm files 
     39   LOGICAL              ::   ln_3d_uve     !: specify whether input velocity data is 3D 
     40   LOGICAL              ::   ln_read_frq   !: specify whether we must read frq or not 
     41   LOGICAL              ::   l_initdone = .false. 
     42   INTEGER     ::   nfld_3d 
     43   INTEGER     ::   nfld_2d 
     44 
     45   INTEGER     ::   jf_tem         ! index of temperature 
     46   INTEGER     ::   jf_sal         ! index of salinity 
     47   INTEGER     ::   jf_usp         ! index of u velocity component 
     48   INTEGER     ::   jf_vsp         ! index of v velocity component 
     49   INTEGER     ::   jf_ssh         ! index of sea surface height 
     50   INTEGER     ::   jf_e3t         ! index of first T level thickness 
     51   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level 
    5052 
    5153   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read) 
    5254   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read) 
    5355 
    54    !! * Substitutions 
    55 #  include "domzgr_substitute.h90" 
    56 #  include "vectopt_loop_substitute.h90" 
    5756   !!---------------------------------------------------------------------- 
    5857   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    59    !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $ 
     58   !! $Id$ 
    6059   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6160   !!---------------------------------------------------------------------- 
     
    8685      IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
    8786      !  
    88       IF( ln_3d_uv ) THEN 
     87      IF( ln_3d_uve ) THEN 
    8988         ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    9089         ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     90         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
    9191      ELSE 
    9292         ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity 
    9393         ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity  
     94         IF( lk_vvl )   e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1)    ! v-velocity  
    9495      ENDIF 
    9596      ! 
     
    9798      sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity 
    9899      ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
    99       ! 
    100       tsn(:,:,1,jp_tem) = sst_m(:,:) 
    101       tsn(:,:,1,jp_sal) = sss_m(:,:) 
     100      IF( ln_read_frq )   frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height 
     101      ! 
    102102      IF ( nn_ice == 1 ) THEN 
     103         tsn(:,:,1,jp_tem) = sst_m(:,:) 
     104         tsn(:,:,1,jp_sal) = sss_m(:,:) 
    103105         tsb(:,:,1,jp_tem) = sst_m(:,:) 
    104106         tsb(:,:,1,jp_sal) = sss_m(:,:) 
    105107      ENDIF 
    106       ub (:,:,1       ) = ssu_m(:,:) 
    107       vb (:,:,1       ) = ssv_m(:,:) 
     108      ub (:,:,1) = ssu_m(:,:) 
     109      vb (:,:,1) = ssv_m(:,:) 
    108110 
    109111      IF(ln_ctl) THEN                  ! print control 
     
    113115         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   ) 
    114116         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   ) 
     117         IF( lk_vvl      )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask, ovlap=1   ) 
     118         IF( ln_read_frq )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask, ovlap=1   ) 
     119      ENDIF 
     120      ! 
     121      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     122         CALL iom_put( 'ssu_m', ssu_m ) 
     123         CALL iom_put( 'ssv_m', ssv_m ) 
     124         CALL iom_put( 'sst_m', sst_m ) 
     125         CALL iom_put( 'sss_m', sss_m ) 
     126         CALL iom_put( 'ssh_m', ssh_m ) 
     127         IF( lk_vvl      )   CALL iom_put( 'e3t_m', e3t_m ) 
     128         IF( ln_read_frq )   CALL iom_put( 'frq_m', frq_m ) 
    115129      ENDIF 
    116130      ! 
     
    138152      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read 
    139153      TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read 
    140       TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 
    141       ! 
    142       NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 
    143       !!---------------------------------------------------------------------- 
     154      TYPE(FLD_N) :: sn_usp, sn_vsp 
     155      TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 
     156      ! 
     157      NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 
     158      !!---------------------------------------------------------------------- 
     159       
     160      IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 
    144161       
    145162      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields 
     
    159176         WRITE(numout,*) '~~~~~~~~~~~ ' 
    160177         WRITE(numout,*) '   Namelist namsbc_sas' 
     178         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve 
     179         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq 
    161180         WRITE(numout,*) 
    162181      ENDIF 
    163        
    164182      ! 
    165183      !! switch off stuff that isn't sensible with a standalone module 
     
    170188         ln_apr_dyn = .FALSE. 
    171189      ENDIF 
    172       IF( ln_dm2dc ) THEN 
    173          IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme' 
    174          ln_dm2dc = .FALSE. 
    175       ENDIF 
    176190      IF( ln_rnf ) THEN 
    177191         IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' 
     
    190204         nn_closea = 0 
    191205      ENDIF 
    192  
    193206      !  
    194207      !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 
    195208      !! when we have other 3d arrays that we need to read in 
    196209      !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 
    197       !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d, 
    198       !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
     210      !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 
     211      !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 
    199212      !! and the rest of the logic should still work 
    200213      ! 
    201       jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 
    202       ! 
    203       IF( ln_3d_uv ) THEN 
    204          jf_usp = 1 ; jf_vsp = 2 
    205          nfld_3d  = 2 
    206          nfld_2d  = 3 
     214      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4   ! default 2D fields index 
     215      ! 
     216      IF( ln_3d_uve ) THEN 
     217         jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3      ! define 3D fields index 
     218         nfld_3d  = 2 + COUNT( (/lk_vvl/) )        ! number of 3D fields to read 
     219         nfld_2d  = 3 + COUNT( (/ln_read_frq/) )   ! number of 2D fields to read 
    207220      ELSE 
    208          jf_usp = 4 ; jf_vsp = 5 
    209          nfld_3d  = 0 
    210          nfld_2d  = 5 
     221         jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) )   ! update 2D fields index 
     222         nfld_3d  = 0                                                              ! no 3D fields to read 
     223         nfld_2d  = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) )             ! number of 2D fields to read 
    211224      ENDIF 
    212225 
     
    216229            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN 
    217230         ENDIF 
    218          IF( ln_3d_uv ) THEN 
    219             slf_3d(jf_usp) = sn_usp 
    220             slf_3d(jf_vsp) = sn_vsp 
    221          ENDIF 
     231         slf_3d(jf_usp) = sn_usp 
     232         slf_3d(jf_vsp) = sn_vsp 
     233         IF( lk_vvl )   slf_3d(jf_e3t) = sn_e3t 
    222234      ENDIF 
    223235 
     
    228240         ENDIF 
    229241         slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 
    230          IF( .NOT. ln_3d_uv ) THEN 
     242         IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq 
     243         IF( .NOT. ln_3d_uve ) THEN 
    231244            slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 
    232          ENDIF 
    233       ENDIF 
    234       ! 
     245            IF( lk_vvl )   slf_2d(jf_e3t) = sn_e3t 
     246         ENDIF 
     247      ENDIF 
     248      ! 
     249      ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.  
    235250      IF( nfld_3d > 0 ) THEN 
    236251         ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure 
     
    265280      ENDIF 
    266281      ! 
    267       ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
    268       ! and ub, vb arrays in ice dynamics 
    269       ! so allocate enough of arrays to use 
    270       ! 
    271       ierr3 = 0 
    272       jpm = MAX(jp_tem, jp_sal) 
    273       ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 ) 
    274       ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 ) 
    275       ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 ) 
    276       IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 ) 
    277       ierr = ierr0 + ierr1 + ierr2 + ierr3 
    278       IF( ierr > 0 ) THEN 
    279          CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays') 
    280       ENDIF 
    281       ! 
    282282      ! finally tidy up 
    283283 
    284284      IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 
    285285      IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 
     286 
     287      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate 
     288      IF( .NOT. ln_read_frq )   frq_m(:,:) = 1. 
     289      l_initdone = .TRUE. 
    286290      ! 
    287291   END SUBROUTINE sbc_ssm_init 
Note: See TracChangeset for help on using the changeset viewer.