Ignore:
Timestamp:
2015-07-16T13:55:15+02:00 (6 years ago)
Author:
cbricaud
Message:

merge change from trunk rev 5003 to 5519 ( rev where branche 3.6_stable were created )

Location:
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    • Property svn:keywords set to Id
    r4162 r5602  
    4545   !!---------------------------------------------------------------------- 
    4646   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    47    !! $Id: daymod.F90 3294 2012-01-28 16:44:18Z rblod $ 
     47   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
     
    8080      ndt05   = NINT(0.5 * rdttra(1)) 
    8181 
    82       ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 
    83       ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
    84       adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    85       IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 
    86       ! 
    87       IF(lwp) THEN 
    88          WRITE(numout,*) ' *** Info used values : ' 
    89          WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    90          WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    91          WRITE(numout,*) 
    92       ENDIF 
     82      ! ==> clem: here we read the ocean restart for the date (only if it exists) 
     83      !           It is not clean and another solution should be found 
     84      CALL day_rst( nit000, 'READ' ) 
     85      ! ==> 
    9386 
    9487      ! set the calendar from ndastp (read in restart file and namelist) 
     
    131124 
    132125      ! 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 = ',   & 
     126      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 = ',   & 
    134127           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    135128 
     
    285278      ! 
    286279   END SUBROUTINE day 
     280 
     281 
     282   SUBROUTINE day_rst( kt, cdrw ) 
     283      !!--------------------------------------------------------------------- 
     284      !!                   ***  ROUTINE ts_rst  *** 
     285      !! 
     286      !!  ** Purpose : Read or write calendar in restart file: 
     287      !! 
     288      !!  WRITE(READ) mode: 
     289      !!       kt        : number of time step since the begining of the experiment at the 
     290      !!                   end of the current(previous) run 
     291      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the 
     292      !!                   end of the current(previous) run (REAL -> keep fractions of day) 
     293      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer) 
     294      !! 
     295      !!   According to namelist parameter nrstdt, 
     296      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary). 
     297      !!       nrstdt = 1  we verify that nit000 is equal to the last 
     298      !!                   time step of previous run + 1. 
     299      !!       In both those options, the  exact duration of the experiment 
     300      !!       since the beginning (cumulated duration of all previous restart runs) 
     301      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     302      !!       This is valid is the time step has remained constant. 
     303      !! 
     304      !!       nrstdt = 2  the duration of the experiment in days (adatrj) 
     305      !!                    has been stored in the restart file. 
     306      !!---------------------------------------------------------------------- 
     307      INTEGER         , INTENT(in) ::   kt         ! ocean time-step 
     308      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
     309      ! 
     310      REAL(wp) ::   zkt, zndastp 
     311      !!---------------------------------------------------------------------- 
     312 
     313      IF( TRIM(cdrw) == 'READ' ) THEN 
     314 
     315         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 
     316            ! Get Calendar informations 
     317            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run 
     318            IF(lwp) THEN 
     319               WRITE(numout,*) ' *** Info read in restart : ' 
     320               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
     321               WRITE(numout,*) ' *** restart option' 
     322               SELECT CASE ( nrstdt ) 
     323               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000' 
     324               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     325               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart' 
     326               END SELECT 
     327               WRITE(numout,*) 
     328            ENDIF 
     329            ! Control of date 
     330            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         & 
     331                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
     332                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
     333            ! define ndastp and adatrj 
     334            IF ( nrstdt == 2 ) THEN 
     335               ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 
     336               CALL iom_get( numror, 'ndastp', zndastp ) 
     337               ndastp = NINT( zndastp ) 
     338               CALL iom_get( numror, 'adatrj', adatrj  ) 
     339            ELSE 
     340               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     341               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     342               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     343               ! note this is wrong if time step has changed during run 
     344            ENDIF 
     345         ELSE 
     346            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     347            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     348            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     349         ENDIF 
     350         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 
     351         ! 
     352         IF(lwp) THEN 
     353            WRITE(numout,*) ' *** Info used values : ' 
     354            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
     355            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     356            WRITE(numout,*) 
     357         ENDIF 
     358         ! 
     359      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
     360         ! 
     361         IF( kt == nitrst ) THEN 
     362            IF(lwp) WRITE(numout,*) 
     363            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt 
     364            IF(lwp) WRITE(numout,*) '~~~~~~~' 
     365         ENDIF 
     366         ! calendar control 
     367         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step 
     368         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date 
     369         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
     370         !                                                                     ! the begining of the run [s] 
     371      ENDIF 
     372      ! 
     373   END SUBROUTINE day_rst 
    287374   !!====================================================================== 
    288375END MODULE daymod 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    • Property svn:keywords set to Id
    r4292 r5602  
    7070   !!---------------------------------------------------------------------- 
    7171   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    72    !! $Id $ 
     72   !! $Id$ 
    7373   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7474   !!---------------------------------------------------------------------- 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r4624 r5602  
    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 
     61#if defined key_bdy 
     62   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3 
     63   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3 
     64#endif 
     65   USE bdy_par 
    5766 
    5867   IMPLICIT NONE 
     
    6675   !!---------------------------------------------------------------------- 
    6776   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    68    !! $Id: nemogcm.F90 3294 2012-01-28 16:44:18Z rblod $ 
     77   !! $Id$ 
    6978   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7079   !!---------------------------------------------------------------------- 
     
    96105      !                            !-----------------------! 
    97106#if defined key_agrif 
    98       CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     107      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
     108      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     109# if defined key_top 
     110      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     111# endif 
     112# if defined key_lim2 
     113      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
     114# endif 
    99115#endif 
    100116      ! check that all process are still there... If some process have an error, 
     
    118134         IF( lk_mpp )   CALL mpp_max( nstop ) 
    119135      END DO 
     136      ! 
     137      IF( ln_icebergs )   CALL icb_end( nitend ) 
     138 
    120139      !                            !------------------------! 
    121140      !                            !==  finalize the run  ==! 
     
    136155      ! 
    137156      CALL nemo_closefile 
     157      ! 
    138158#if defined key_iomput 
    139159      CALL xios_finalize                ! end mpp communications with xios 
     160      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
    140161#else 
    141       IF( lk_mpp )   CALL mppstop       ! end mpp communications 
     162      IF( lk_oasis ) THEN  
     163         CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     164      ELSE 
     165         IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     166      ENDIF 
    142167#endif 
    143168      ! 
     
    154179      INTEGER ::   ilocal_comm   ! local integer       
    155180      INTEGER ::   ios 
    156  
    157181      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    158       !! 
     182      CHARACTER(len=80) ::   clname 
     183      ! 
    159184      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    160185         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    161186         &             nn_bench, nn_timing 
    162187      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    163          &             jpizoom, jpjzoom, jperio 
    164       !!---------------------------------------------------------------------- 
     188         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
     189      !!---------------------------------------------------------------------- 
     190      ! 
    165191      cltxt = '' 
    166192      ! 
    167193      !                             ! 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. ) 
     194      IF( lk_oasis ) THEN  
     195         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     196         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     197         cxios_context = 'sas' 
     198         clname = 'output.namelist_sas.dyn' 
     199      ELSE 
     200         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     201         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     202         cxios_context = 'nemo' 
     203         clname = 'output.namelist.dyn' 
     204   ENDIF 
    170205      ! 
    171206      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     
    186221904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    187222 
     223! Force values for AGRIF zoom (cf. agrif_user.F90) 
     224#if defined key_agrif 
     225   IF( .NOT. Agrif_Root() ) THEN 
     226      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     227      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     228      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     229      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     230      jpidta  = jpiglo 
     231      jpjdta  = jpjglo 
     232      jpizoom = 1 
     233      jpjzoom = 1 
     234      nperio  = 0 
     235      jperio  = 0 
     236      ln_use_jattr = .false. 
     237   ENDIF 
     238#endif 
     239      ! 
    188240      !                             !--------------------------------------------! 
    189241      !                             !  set communicator & select the local node  ! 
     
    193245#if defined key_iomput 
    194246      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 
     247         IF( lk_oasis ) THEN 
     248            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis  
     249            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     250         ELSE 
     251            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios 
     252         ENDIF 
     253      ENDIF 
     254      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
    198255#else 
    199       ilocal_comm = 0 
    200       narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )        ! Nodes selection (control print return in cltxt) 
     256      IF( lk_oasis ) THEN 
     257         IF( Agrif_Root() ) THEN 
     258            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
     259         ENDIF 
     260         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     261      ELSE 
     262         ilocal_comm = 0 
     263         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
     264      ENDIF 
    201265#endif 
    202266      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
     
    229293      ! than variables 
    230294      IF( Agrif_Root() ) THEN 
     295#if defined key_nemocice_decomp 
     296         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     297         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     298#else 
    231299         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 
    235300         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    236301#endif 
     302      ENDIF 
    237303         jpk = jpkdta                                             ! third dim 
    238304         jpim1 = jpi-1                                            ! inner domain indices 
     
    240306         jpkm1 = jpk-1                                            !   "           " 
    241307         jpij  = jpi*jpj                                          !  jpi x j 
    242       ENDIF 
    243308 
    244309      IF(lwp) THEN                            ! open listing units 
    245310         ! 
    246          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     311         IF( lk_oasis ) THEN 
     312            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     313         ELSE 
     314            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     315         ENDIF 
    247316         ! 
    248317         WRITE(numout,*) 
     
    250319         WRITE(numout,*) '                       NEMO team' 
    251320         WRITE(numout,*) '            Ocean General Circulation Model' 
    252          WRITE(numout,*) '                  version 3.4  (2011) ' 
     321         WRITE(numout,*) '                  version 3.6  (2015) ' 
    253322         WRITE(numout,*) '             StandAlone Surface version (SAS) ' 
    254323         WRITE(numout,*) 
     
    287356 
    288357      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    289                             CALL flush(numout) 
    290  
    291358                            CALL day_init   ! model calendar (using both namelist and restart infos) 
    292359 
    293360                            CALL sbc_init   ! Forcings : surface module  
     361                             
     362      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from   
     363      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.  
     364      !           This is not clean and should be changed in the future.  
     365      IF( lk_bdy        )   CALL     bdy_init 
     366      IF( lk_bdy        )   CALL bdy_dta_init 
     367      ! ==> 
    294368       
    295369      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     
    348422         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    349423         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
     424         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
    350425      ENDIF 
    351426      !                             ! Parameter control 
     
    396471      ENDIF 
    397472      ! 
     473      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     474         &                                               'f2003 standard. '                              ,  & 
     475         &                                               'Compile with key_nosignedzero enabled' ) 
     476      ! 
    398477   END SUBROUTINE nemo_ctl 
    399478 
     
    435514      USE diawri    , ONLY: dia_wri_alloc 
    436515      USE dom_oce   , ONLY: dom_oce_alloc 
    437       USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    438       ! 
    439       INTEGER :: ierr,ierr4 
     516#if defined key_bdy    
     517      USE bdy_oce   , ONLY: bdy_oce_alloc 
     518      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays 
     519#else 
     520      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
     521#endif 
     522      ! 
     523      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
     524      INTEGER :: jpm 
    440525      !!---------------------------------------------------------------------- 
    441526      ! 
    442527      ierr =        dia_wri_alloc   () 
    443528      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    444       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    445          &      snwice_fmass(jpi,jpj), STAT= ierr4 ) 
    446       ierr = ierr + ierr4 
     529#if defined key_bdy 
     530      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization) 
     531      ierr = ierr + oce_alloc       ()          ! (tsn...) 
     532#endif 
     533 
     534#if ! defined key_bdy 
     535       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
     536         &      snwice_fmass(jpi,jpj)  , STAT= ierr1 ) 
     537      ! 
     538      ! lim code currently uses surface temperature and salinity in tsn array for initialisation 
     539      ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use 
     540      ! clem: should not be needed. To be checked out 
     541      jpm = MAX(jp_tem, jp_sal) 
     542      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
     543      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
     544      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
     545      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
     546      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
     547      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  
     548#endif 
    447549      ! 
    448550      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    469571      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    470572      !!---------------------------------------------------------------------- 
    471  
     573      ! 
    472574      ierr = 0 
    473  
     575      ! 
    474576      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    475  
     577      ! 
    476578      IF( nfact <= 1 ) THEN 
    477579         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     
    515617      INTEGER, PARAMETER :: ntest = 14 
    516618      INTEGER :: ilfax(ntest) 
    517  
     619      ! 
    518620      ! lfax contains the set of allowed factors. 
    519621      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
     
    600702          !loop over the other north-fold processes to find the processes 
    601703          !managing the points belonging to the sxT-dxT range 
    602           DO jn = jpnij - jpni +1, jpnij 
    603              IF ( njmppt(jn) == njmppmax ) THEN 
     704   
     705          DO jn = 1, jpni 
    604706                !sxT is the first point (in the global domain) of the jn 
    605707                !process 
    606                 sxT = nimppt(jn) 
     708                sxT = nfiimpp(jn, jpnj) 
    607709                !dxT is the last point (in the global domain) of the jn 
    608710                !process 
    609                 dxT = nimppt(jn) + nlcit(jn) - 1 
     711                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    610712                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    611713                   nsndto = nsndto + 1 
    612                    isendto(nsndto) = jn 
    613                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     714                     isendto(nsndto) = jn 
     715                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    614716                   nsndto = nsndto + 1 
    615717                   isendto(nsndto) = jn 
     
    618720                   isendto(nsndto) = jn 
    619721                END IF 
    620              END IF 
    621722          END DO 
     723          nfsloop = 1 
     724          nfeloop = nlci 
     725          DO jn = 2,jpni-1 
     726           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     727              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     728                 nfsloop = nldi 
     729              ENDIF 
     730              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     731                 nfeloop = nlei 
     732              ENDIF 
     733           ENDIF 
     734        END DO 
     735 
    622736      ENDIF 
    623737      l_north_nogather = .TRUE. 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    • Property svn:keywords set to Id
    r4990 r5602  
    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 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/step.F90

    • Property svn:keywords set to Id
    r4166 r5602  
    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 
     
    3638   USE timing           ! Timing             
    3739 
     40   USE bdy_par          ! clem: mandatory for LIM3 
     41#if defined key_bdy 
     42   USE bdydta           ! clem: mandatory for LIM3 
     43#endif 
     44 
    3845   IMPLICIT NONE 
    3946   PRIVATE 
     
    4653   !!---------------------------------------------------------------------- 
    4754   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    48    !! $Id: step.F90 3294 2012-01-28 16:44:18Z rblod $ 
     55   !! $Id$ 
    4956   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5057   !!---------------------------------------------------------------------- 
     
    7279      kstp = nit000 + Agrif_Nb_Step() 
    7380# if defined key_iomput 
    74       IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" ) 
     81      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    7582# endif    
    7683#endif    
    77       IF( kstp == nit000 )   CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     84      IF( kstp == nit000 )   CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    7885      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 
     86                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
    8087 
     88      ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from   
     89      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
     90      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.   
     91      !           This is not clean and should be changed in the future.  
     92#if defined key_bdy 
     93      IF( lk_bdy     )       CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
     94#endif 
     95      ! ==> 
    8196                             CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    8297 
     
    86101                                                          ! need to keep the same interface  
    87102                             CALL stp_ctl( kstp, indic ) 
     103      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     104      ! Coupled mode 
     105      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     106      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     107 
    88108#if defined key_iomput 
    89       IF( kstp == nitend )   CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     109      IF( kstp == nitend .OR. indic < 0 ) THEN  
     110                             CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
     111      ENDIF 
    90112#endif 
    91113      ! 
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/stpctl.F90

    • Property svn:keywords set to Id
    r3358 r5602  
    2828   !!---------------------------------------------------------------------- 
    2929   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    30    !! $Id: stpctl.F90 3294 2012-01-28 16:44:18Z rblod $ 
     30   !! $Id$ 
    3131   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3232   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.