Ignore:
Timestamp:
2015-06-11T21:13:22+02:00 (6 years ago)
Author:
smasson
Message:

merge dev_r5218_CNRS17_coupling into the trunk

Location:
trunk/NEMOGCM/NEMO/SAS_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r5215 r5407  
    131131 
    132132      ! control print 
    133       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
     133      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    134134           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    135135 
  • trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r5215 r5407  
    4242   USE step_oce        ! module used in the ocean time stepping module 
    4343   USE sbc_oce         ! surface boundary condition: ocean 
    44    USE cla             ! cross land advection               (tra_cla routine) 
    4544   USE domcfg          ! domain configuration               (dom_cfg routine) 
    4645   USE daymod          ! calendar 
     
    5049   USE step            ! NEMO time-stepping                 (stp     routine) 
    5150   USE lib_mpp         ! distributed memory computing 
     51#if defined key_nosignedzero 
     52   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     53#endif 
    5254#if defined key_iomput 
    5355   USE xios 
    5456#endif 
     57   USE cpl_oasis3 
    5558   USE sbcssm 
    56    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     59   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
     60   USE icbstp          ! handle bergs, calving, themodynamics and transport 
    5761 
    5862   IMPLICIT NONE 
     
    96100      !                            !-----------------------! 
    97101#if defined key_agrif 
    98       CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     102      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
     103      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     104# if defined key_top 
     105      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     106# endif 
     107# if defined key_lim2 
     108      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
     109# endif 
    99110#endif 
    100111      ! check that all process are still there... If some process have an error, 
     
    118129         IF( lk_mpp )   CALL mpp_max( nstop ) 
    119130      END DO 
     131      ! 
     132      IF( ln_icebergs )   CALL icb_end( nitend ) 
     133 
    120134      !                            !------------------------! 
    121135      !                            !==  finalize the run  ==! 
     
    136150      ! 
    137151      CALL nemo_closefile 
     152      ! 
    138153#if defined key_iomput 
    139154      CALL xios_finalize                ! end mpp communications with xios 
     155      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    140156#else 
    141       IF( lk_mpp )   CALL mppstop       ! end mpp communications 
     157      IF( lk_oasis ) THEN  
     158         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     159      ELSE 
     160         IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     161      ENDIF 
    142162#endif 
    143163      ! 
     
    154174      INTEGER ::   ilocal_comm   ! local integer       
    155175      INTEGER ::   ios 
    156  
    157176      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    158       !! 
     177      CHARACTER(len=80) ::   clname 
     178      ! 
    159179      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    160180         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
     
    163183         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    164184      !!---------------------------------------------------------------------- 
     185      ! 
    165186      cltxt = '' 
    166187      ! 
    167188      !                             ! Open reference namelist and configuration namelist files 
    168       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    169       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     189      IF( lk_oasis ) THEN  
     190         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     191         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     192         cxios_context = 'sas' 
     193         clname = 'output.namelist_sas.dyn' 
     194      ELSE 
     195         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     196         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     197         cxios_context = 'nemo' 
     198         clname = 'output.namelist.dyn' 
     199   ENDIF 
    170200      ! 
    171201      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     
    186216904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    187217 
     218! Force values for AGRIF zoom (cf. agrif_user.F90) 
     219#if defined key_agrif 
     220   IF( .NOT. Agrif_Root() ) THEN 
     221      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     222      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     223      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     224      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     225      jpidta  = jpiglo 
     226      jpjdta  = jpjglo 
     227      jpizoom = 1 
     228      jpjzoom = 1 
     229      nperio  = 0 
     230      jperio  = 0 
     231      ln_use_jattr = .false. 
     232   ENDIF 
     233#endif 
     234      ! 
    188235      !                             !--------------------------------------------! 
    189236      !                             !  set communicator & select the local node  ! 
     
    193240#if defined key_iomput 
    194241      IF( Agrif_Root() ) THEN 
    195          CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
    196       ENDIF 
    197       narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
     242         IF( lk_oasis ) THEN 
     243            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis  
     244            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     245         ELSE 
     246            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios 
     247         ENDIF 
     248      ENDIF 
     249      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
    198250#else 
    199       ilocal_comm = 0 
    200       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )        ! Nodes selection (control print return in cltxt) 
     251      IF( lk_oasis ) THEN 
     252         IF( Agrif_Root() ) THEN 
     253            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
     254         ENDIF 
     255         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     256      ELSE 
     257         ilocal_comm = 0 
     258         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     259      ENDIF 
    201260#endif 
    202261      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
     
    229288      ! than variables 
    230289      IF( Agrif_Root() ) THEN 
     290#if defined key_nemocice_decomp 
     291         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     292         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     293#else 
    231294         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    232 #if defined key_nemocice_decomp 
    233          jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    234 #else 
    235295         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    236296#endif 
     297      ENDIF 
    237298         jpk = jpkdta                                             ! third dim 
    238299         jpim1 = jpi-1                                            ! inner domain indices 
     
    240301         jpkm1 = jpk-1                                            !   "           " 
    241302         jpij  = jpi*jpj                                          !  jpi x j 
    242       ENDIF 
    243303 
    244304      IF(lwp) THEN                            ! open listing units 
    245305         ! 
    246          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     306         IF( lk_oasis ) THEN 
     307            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     308         ELSE 
     309            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     310         ENDIF 
    247311         ! 
    248312         WRITE(numout,*) 
     
    287351 
    288352      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    289                             CALL flush(numout) 
    290  
    291353                            CALL day_init   ! model calendar (using both namelist and restart infos) 
    292354 
     
    397459      ENDIF 
    398460      ! 
     461      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     462         &                                               'f2003 standard. '                              ,  & 
     463         &                                               'Compile with key_nosignedzero enabled' ) 
     464      ! 
    399465   END SUBROUTINE nemo_ctl 
    400466 
     
    438504      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    439505      ! 
    440       INTEGER :: ierr,ierr4 
     506      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
     507      INTEGER :: jpm 
    441508      !!---------------------------------------------------------------------- 
    442509      ! 
     
    444511      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    445512      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    446          &      snwice_fmass(jpi,jpj), STAT= ierr4 ) 
    447       ierr = ierr + ierr4 
     513         &      snwice_fmass(jpi,jpj), STAT= ierr1 ) 
     514      ! 
     515      ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
     516      ! and ub, vb arrays in ice dynamics 
     517      ! so allocate enough of arrays to use 
     518      ! 
     519      jpm = MAX(jp_tem, jp_sal) 
     520      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
     521      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
     522      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
     523      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
     524      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
     525 
     526      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  
    448527      ! 
    449528      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    470549      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    471550      !!---------------------------------------------------------------------- 
    472  
     551      ! 
    473552      ierr = 0 
    474  
     553      ! 
    475554      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    476  
     555      ! 
    477556      IF( nfact <= 1 ) THEN 
    478557         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     
    516595      INTEGER, PARAMETER :: ntest = 14 
    517596      INTEGER :: ilfax(ntest) 
    518  
     597      ! 
    519598      ! lfax contains the set of allowed factors. 
    520599      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
     
    601680          !loop over the other north-fold processes to find the processes 
    602681          !managing the points belonging to the sxT-dxT range 
    603           DO jn = jpnij - jpni +1, jpnij 
    604              IF ( njmppt(jn) == njmppmax ) THEN 
     682   
     683          DO jn = 1, jpni 
    605684                !sxT is the first point (in the global domain) of the jn 
    606685                !process 
    607                 sxT = nimppt(jn) 
     686                sxT = nfiimpp(jn, jpnj) 
    608687                !dxT is the last point (in the global domain) of the jn 
    609688                !process 
    610                 dxT = nimppt(jn) + nlcit(jn) - 1 
     689                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    611690                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    612691                   nsndto = nsndto + 1 
    613                    isendto(nsndto) = jn 
    614                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     692                     isendto(nsndto) = jn 
     693                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    615694                   nsndto = nsndto + 1 
    616695                   isendto(nsndto) = jn 
     
    619698                   isendto(nsndto) = jn 
    620699                END IF 
    621              END IF 
    622700          END DO 
     701          nfsloop = 1 
     702          nfeloop = nlci 
     703          DO jn = 2,jpni-1 
     704           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     705              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     706                 nfsloop = nldi 
     707              ENDIF 
     708              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     709                 nfeloop = nlei 
     710              ENDIF 
     711           ENDIF 
     712        END DO 
     713 
    623714      ENDIF 
    624715      l_north_nogather = .TRUE. 
  • trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r5215 r5407  
    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) 
     
    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 
  • trunk/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5215 r5407  
    1717   USE dom_oce          ! ocean space and time domain variables  
    1818   USE in_out_manager   ! I/O manager 
     19   USE sbc_oce 
     20   USE sbccpl 
    1921   USE iom              ! 
    2022   USE lbclnk 
     
    7274      kstp = nit000 + Agrif_Nb_Step() 
    7375# if defined key_iomput 
    74       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
     76      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    7577# endif    
    7678#endif    
    77       IF( kstp == nit000 )   CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     79      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    7880      IF( kstp /= nit000 )   CALL day( kstp )             ! Calendar (day was already called at nit000 in day_init) 
    79                              CALL iom_setkt( kstp, "nemo" )       ! say to iom that we are at time step kstp 
     81                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
    8082 
    8183                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
     
    8688                                                          ! need to keep the same interface  
    8789                             CALL stp_ctl( kstp, indic ) 
     90      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     91      ! Coupled mode 
     92      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     93      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     94 
    8895#if defined key_iomput 
    89       IF( kstp == nitend )   CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     96      IF( kstp == nitend .OR. indic < 0 ) THEN  
     97                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     98      ENDIF 
    9099#endif 
    91100      ! 
Note: See TracChangeset for help on using the changeset viewer.