Ignore:
Timestamp:
2015-06-19T17:18:00+02:00 (5 years ago)
Author:
davestorkey
Message:

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    • Property svn:keywords set to Id
    r5234 r5443  
    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,   & 
    161181         &             nn_bench, nn_timing 
    162182      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    163          &             jpizoom, jpjzoom, jperio 
    164       !!---------------------------------------------------------------------- 
     183         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
     184      !!---------------------------------------------------------------------- 
     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,*) 
     
    250314         WRITE(numout,*) '                       NEMO team' 
    251315         WRITE(numout,*) '            Ocean General Circulation Model' 
    252          WRITE(numout,*) '                  version 3.4  (2011) ' 
     316         WRITE(numout,*) '                  version 3.6  (2015) ' 
    253317         WRITE(numout,*) '             StandAlone Surface version (SAS) ' 
    254318         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 
     
    348410         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    349411         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
     412         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
    350413      ENDIF 
    351414      !                             ! Parameter control 
     
    396459      ENDIF 
    397460      ! 
     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      ! 
    398465   END SUBROUTINE nemo_ctl 
    399466 
     
    437504      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    438505      ! 
    439       INTEGER :: ierr,ierr4 
     506      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
     507      INTEGER :: jpm 
    440508      !!---------------------------------------------------------------------- 
    441509      ! 
     
    443511      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    444512      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    445          &      snwice_fmass(jpi,jpj), STAT= ierr4 ) 
    446       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  
    447527      ! 
    448528      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    469549      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    470550      !!---------------------------------------------------------------------- 
    471  
     551      ! 
    472552      ierr = 0 
    473  
     553      ! 
    474554      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    475  
     555      ! 
    476556      IF( nfact <= 1 ) THEN 
    477557         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     
    515595      INTEGER, PARAMETER :: ntest = 14 
    516596      INTEGER :: ilfax(ntest) 
    517  
     597      ! 
    518598      ! lfax contains the set of allowed factors. 
    519599      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
     
    600680          !loop over the other north-fold processes to find the processes 
    601681          !managing the points belonging to the sxT-dxT range 
    602           DO jn = jpnij - jpni +1, jpnij 
    603              IF ( njmppt(jn) == njmppmax ) THEN 
     682   
     683          DO jn = 1, jpni 
    604684                !sxT is the first point (in the global domain) of the jn 
    605685                !process 
    606                 sxT = nimppt(jn) 
     686                sxT = nfiimpp(jn, jpnj) 
    607687                !dxT is the last point (in the global domain) of the jn 
    608688                !process 
    609                 dxT = nimppt(jn) + nlcit(jn) - 1 
     689                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    610690                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    611691                   nsndto = nsndto + 1 
    612                    isendto(nsndto) = jn 
    613                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     692                     isendto(nsndto) = jn 
     693                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    614694                   nsndto = nsndto + 1 
    615695                   isendto(nsndto) = jn 
     
    618698                   isendto(nsndto) = jn 
    619699                END IF 
    620              END IF 
    621700          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 
    622714      ENDIF 
    623715      l_north_nogather = .TRUE. 
Note: See TracChangeset for help on using the changeset viewer.