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 4792 – NEMO

Changeset 4792


Ignore:
Timestamp:
2014-09-26T13:04:47+02:00 (10 years ago)
Author:
jamesharle
Message:

Updates to code after first successful test + merge with HEAD of trunk

Location:
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC
Files:
82 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r4313 r4792  
    154154      READ  ( numnam_cfg, nam_asminc, IOSTAT = ios, ERR = 902 ) 
    155155902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_asminc in configuration namelist', lwp ) 
    156       WRITE ( numond, nam_asminc ) 
     156      IF(lwm) WRITE ( numond, nam_asminc ) 
    157157 
    158158      ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r4694 r4792  
    105105   REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
    106106 
    107 #if ( defined key_lim2 || defined key_lim3 ) 
    108107   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables  
    109108   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
    110109                                                              !: = 1 read it in a NetCDF file 
    111 #endif 
     110   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice 
     111   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice 
     112   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice 
    112113   ! 
    113114    

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r4694 r4792  
    532532            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    533533902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
    534             WRITE ( numond, nambdy_dta ) 
     534            IF(lwm) WRITE ( numond, nambdy_dta ) 
    535535 
    536536            cn_dir_array(ib_bdy) = cn_dir 
    … …  
    676676               CALL iom_close ( inum ) 
    677677               !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
    678                !CALL iom_open ( bn_a_i %clname, inum ) 
     678               !CALL iom_open ( bn_a_i%clname, inum ) 
    679679               !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
    680680                IF ( zndims == 4 ) THEN 
    … …  
    740740      jstart = 1 
    741741      DO ib_bdy = 1, nb_bdy 
    742          jend = nb_bdy_fld(ib_bdy)  
     742         jend = jstart - 1 + nb_bdy_fld(ib_bdy)  
    743743         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta',   & 
    744744         &              'open boundary conditions', 'nambdy_dta' ) 
    … …  
    912912   !!============================================================================== 
    913913END MODULE bdydta 
    914  
    915  

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4370 r4792  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE in_out_manager  ! 
    32    USE domvvl 
     32   USE domvvl          ! variable volume 
    3333 
    3434   IMPLICIT NONE 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r4333 r4792  
    2424   USE par_ice_2 
    2525   USE ice_2           ! LIM_2 ice variables 
     26   USE dom_ice_2       ! sea-ice domain 
    2627#elif defined key_lim3 
    2728   USE par_ice 
    2829   USE ice             ! LIM_3 ice variables 
     30   USE dom_ice         ! sea-ice domain 
    2931#endif  
    3032   USE par_oce         ! ocean parameters 
    3133   USE dom_oce         ! ocean space and time domain variables  
    32    USE dom_ice          ! sea-ice domain 
    3334   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3435   USE bdy_oce         ! ocean open boundary conditions 
    … …  
    99100      REAL(wp) ::   zinda, ztmelts, zdh 
    100101 
    101       REAL(wp), PARAMETER  ::   zsal = 6.3    ! arbitrary salinity    for incoming ice 
    102       REAL(wp), PARAMETER  ::   ztem = 270.0  ! arbitrary temperature for incoming ice 
    103       REAL(wp), PARAMETER  ::   zage = 30.0   ! arbitrary age         for incoming ice 
    104102      !!------------------------------------------------------------------------------ 
    105103      ! 
    … …  
    233231 
    234232               ! Ice salinity, age, temperature 
    235                sm_i(ji,jj,jl)   = zinda * zsal  + ( 1.0 - zinda ) * s_i_min 
    236                o_i(ji,jj,jl)    = zinda * zage  + ( 1.0 - zinda ) 
    237                t_su(ji,jj,jl)   = zinda * ztem  + ( 1.0 - zinda ) * ztem 
     233               sm_i(ji,jj,jl)   = zinda * rn_ice_sal(ib_bdy)  + ( 1.0 - zinda ) * s_i_min 
     234               o_i(ji,jj,jl)    = zinda * rn_ice_age(ib_bdy)  + ( 1.0 - zinda ) 
     235               t_su(ji,jj,jl)   = zinda * rn_ice_tem(ib_bdy)  + ( 1.0 - zinda ) * rn_ice_tem(ib_bdy) 
    238236               DO jk = 1, nlay_s 
    239                   t_s(ji,jj,jk,jl) = zinda * ztem + ( 1.0 - zinda ) * rtt 
     237                  t_s(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 
    240238               END DO 
    241239               DO jk = 1, nlay_i 
    242                   t_i(ji,jj,jk,jl) = zinda * ztem + ( 1.0 - zinda ) * rtt  
    243                   s_i(ji,jj,jk,jl) = zinda * zsal + ( 1.0 - zinda ) * s_i_min 
     240                  t_i(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt  
     241                  s_i(ji,jj,jk,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 
    244242               END DO 
    245243                
    … …  
    259257 
    260258            END SELECT 
     259 
     260            ! if salinity is constant, then overwrite rn_ice_sal 
     261            IF( num_sal == 1 ) THEN 
     262               sm_i(ji,jj,jl)   = bulk_sal 
     263               s_i (ji,jj,:,jl) = bulk_sal 
     264            ENDIF 
    261265 
    262266            ! contents 
    … …  
    338342      DO ib_bdy=1, nb_bdy 
    339343         ! 
    340          SELECT CASE( nn_ice_lim(ib_bdy) ) 
     344         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    341345 
    342346         CASE('none') 
    … …  
    355359                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    356360                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    357                   zflag = idx_bdy(ib_bdy)%flagu(jb) 
     361                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
    358362                   
    359363                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    … …  
    384388                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    385389                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    386                   zflag = idx_bdy(ib_bdy)%flagv(jb) 
     390                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
    387391                   
    388392                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4694 r4792  
    100100         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
    101101         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    102 #if ( defined key_lim2 || defined key_lim3 ) 
    103102         &             cn_ice_lim, nn_ice_lim_dta,                           & 
    104 #endif 
     103         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
    105104         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
    106105      !! 
    … …  
    132131      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    133132902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    134       WRITE ( numond, nambdy ) 
     133      IF(lwm) WRITE ( numond, nambdy ) 
    135134 
    136135      ! ----------------------------------------- 
    … …  
    359358        ENDIF 
    360359        IF(lwp) WRITE(numout,*) 
     360        IF(lwp) WRITE(numout,*) '      tem of bdy sea-ice = ', rn_ice_tem(ib_bdy)          
     361        IF(lwp) WRITE(numout,*) '      sal of bdy sea-ice = ', rn_ice_sal(ib_bdy)          
     362        IF(lwp) WRITE(numout,*) '      age of bdy sea-ice = ', rn_ice_age(ib_bdy)          
    361363#endif 
    362364 
    … …  
    384386        ELSE 
    385387           IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***' 
     388        ENDIF 
    386389     ENDIF 
    387390 
    … …  
    422425            READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
    423426904         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist', lwp ) 
    424             WRITE ( numond, nambdy_index ) 
     427            IF(lwm) WRITE ( numond, nambdy_index ) 
    425428 
    426429            SELECT CASE ( TRIM(ctypebdy) ) 
    … …  
    509512            &      nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
    510513 
    511          IF( jpk_bdy>0 ) THEN 
    512             ALLOCATE( dta_global(jpbdtau, 1, jpk_bdy) ) 
    513             ALLOCATE( dta_global_z(jpbdtau, 1, jpk_bdy) ) 
     514         IF( nb_jpk_bdy>0 ) THEN 
     515            ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) ) 
     516            ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) ) 
    514517         ELSE 
    515518            ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 
    … …  
    518521 
    519522         IF ( icount>0 ) THEN 
    520             IF( jpk_bdy>0 ) THEN 
    521                ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk_bdy) ) 
    522                ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk_bdy) ) 
     523            IF( nb_jpk_bdy>0 ) THEN 
     524               ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) ) 
     525               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) ) 
    523526            ELSE 
    524527               ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 
    525528               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) 
    526529            ENDIF 
     530         ENDIF 
    527531         !  
    528532      ENDIF 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r4354 r4792  
    117117            READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 
    118118902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist', lwp ) 
    119             WRITE ( numond, nambdy_tide ) 
     119            IF(lwm) WRITE ( numond, nambdy_tide ) 
    120120            !                                               ! Parameter control and print 
    121121            IF(lwp) WRITE(numout,*) '  ' 
    … …  
    418418      DO ib_bdy = 1,nb_bdy 
    419419 
    420          ! line below should be simplified (runoff case) 
    421 !! CHANUT: TO BE SORTED OUT 
    422 !!         IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
    423420         IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    424421 
    … …  
    453450            IF ( PRESENT(kit) ) THEN 
    454451               IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 
    455                   dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
    456                   dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
    457                   dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
     452                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
     453                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
     454                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
    458455 
    459456               ELSE ! Initialize arrays from slow varying open boundary data:             
    460                   dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    461                   dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    462                   dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     457                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
     458                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
     459                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    463460               ENDIF 
    464461            ENDIF 
    … …  
    471468               z_sist = zramp * SIN( z_sarg ) 
    472469               ! 
    473                igrd=1                              ! SSH on tracer grid 
    474                DO ib = 1, ilen0(igrd) 
    475                   dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
    476                      &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
    477                      &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist ) 
    478                END DO 
    479                ! 
    480                igrd=2                              ! U grid 
    481                DO ib = 1, ilen0(igrd) 
    482                   dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
    483                      &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
    484                      &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    485                END DO 
    486                ! 
    487                igrd=3                              ! V grid 
    488                DO ib = 1, ilen0(igrd)  
    489                   dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
    490                      &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
    491                      &                        tides(ib_bdy)%v(ib,itide,2)*z_sist ) 
    492                END DO 
    493             END DO 
     470               IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN 
     471                  igrd=1                              ! SSH on tracer grid 
     472                  DO ib = 1, ilen0(igrd) 
     473                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
     474                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
     475                        &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist ) 
     476                  END DO 
     477               ENDIF 
     478               ! 
     479               IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN 
     480                  igrd=2                              ! U grid 
     481                  DO ib = 1, ilen0(igrd) 
     482                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
     483                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
     484                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
     485                  END DO 
     486               ENDIF 
     487               ! 
     488               IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN 
     489                  igrd=3                              ! V grid 
     490                  DO ib = 1, ilen0(igrd)  
     491                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
     492                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
     493                        &                        tides(ib_bdy)%v(ib,itide,2)*z_sist ) 
     494                  END DO 
     495               ENDIF 
     496            END DO              
    494497         END IF 
    495498      END DO 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    r4247 r4792  
    2727   REAL(wp), PUBLIC            ::  rn_lat1d     ! Column latitude 
    2828   REAL(wp), PUBLIC            ::  rn_lon1d     ! Column longitude 
     29   LOGICAL , PUBLIC            ::  ln_c1d_locpt ! Localization (or not) of 1D column in a grid 
    2930 
    3031   !!---------------------------------------------------------------------- 
    … …  
    4445      !!---------------------------------------------------------------------- 
    4546      INTEGER ::   ios                 ! Local integer output status for namelist read 
    46       NAMELIST/namc1d/ rn_lat1d, rn_lon1d 
     47      NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt 
    4748      !!---------------------------------------------------------------------- 
    4849      ! 
    … …  
    5556      READ  ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 ) 
    5657902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 
    57       WRITE ( numond, namc1d ) 
     58      IF(lwm) WRITE ( numond, namc1d ) 
    5859 
    5960      ! 
    … …  
    6364         WRITE(numout,*) '~~~~~~~~' 
    6465         WRITE(numout,*) '   Namelist namc1d : set options for the C1D model' 
    65          WRITE(numout,*) '      column latitude                 rn_lat1d = ', rn_lat1d 
    66          WRITE(numout,*) '      column longitude                rn_lon1d = ', rn_lon1d 
     66         WRITE(numout,*) '      column latitude                 rn_lat1d     = ', rn_lat1d 
     67         WRITE(numout,*) '      column longitude                rn_lon1d     = ', rn_lon1d 
     68         WRITE(numout,*) '      column localization in a grid   ln_c1d_locpt = ', ln_c1d_locpt 
    6769      ENDIF 
    6870      ! 
    … …  
    7880   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated 
    7981   REAL(wp)                   ::   rn_lat1d, rn_lon1d 
     82   LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE.  
     83 
    8084CONTAINS 
    8185 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r4245 r4792  
    4343      !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom) 
    4444      !!---------------------------------------------------------------------- 
     45      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
     46         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
     47         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    & 
     48         &             jphgr_msh, & 
     49         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
     50         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     51         &             ppa2, ppkth2, ppacr2 
     52 
    4553      INTEGER  ::  ji, jj                          ! Dummy loop indices 
    4654      INTEGER  ::  inum                            ! Coordinate file handle (case 0) 
    4755      INTEGER  ::  ijeq                            ! Index of equator T point (case 4) 
     56      INTEGER  ::  ios                             ! Local integer output status for namelist read 
    4857 
    4958      INTEGER , DIMENSION(2) ::   iloc             ! Minloc returned indices 
    … …  
    6372      IF( nn_timing == 1 )   CALL timing_start('dom_c1d') 
    6473 
     74      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
     75      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 
     76901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
     77   
     78      ! 
     79      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
     80      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 
     81902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     82 
    6583      CALL wrk_alloc( jpidta, jpjdta, gphidta, glamdta, zdist ) 
    6684 
    … …  
    8098         CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data 
    8199         CALL iom_close ( inum ) 
    82  
    83          PRINT *,'Check dom_c1d coordinates file data read in:' !!! 
    84          PRINT *,'Bottom-left most glamdta is ', glamdta(1,1)    !!! Need to check 
    85          PRINT *,'Bottom-left most gphidta is ', gphidta(1,1)    !!! field read 
    86          PRINT *,'We are using nimpp,njmpp = ' , nimpp,njmpp     !!! 
    87100 
    88101      CASE ( 1 )                 ! geographical mesh on the sphere with regular grid-spacing 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    r4294 r4792  
    7373      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 
    7474902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
    75       WRITE ( numond, namc1d_uvd ) 
     75      IF(lwm) WRITE ( numond, namc1d_uvd ) 
    7676 
    7777      !                             ! force the initialization when dyndmp is used 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90

    r4367 r4792  
    8484      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 
    8585902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 
    86       WRITE ( numond, namc1d_dyndmp ) 
     86      IF(lwm) WRITE ( numond, namc1d_dyndmp ) 
    8787 
    8888      IF(lwp) THEN                           ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r4294 r4792  
    9292      READ  ( numnam_cfg, namcrs, IOSTAT = ios, ERR = 902 ) 
    9393902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcrs in configuration namelist', lwp ) 
    94       WRITE ( numond, namcrs ) 
     94      IF(lwm) WRITE ( numond, namcrs ) 
    9595 
    9696     IF(lwp) THEN 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r4613 r4792  
    151151     READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 ) 
    152152902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp ) 
    153      WRITE ( numond, namdct ) 
     153     IF(lwm) WRITE ( numond, namdct ) 
    154154 
    155155     IF( lwp ) THEN 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r4292 r4792  
    1818   USE daymod 
    1919   USE tide_mod 
     20   ! 
    2021   USE in_out_manager  ! I/O units 
    2122   USE iom             ! I/0 library 
    … …  
    3435   INTEGER, PARAMETER :: jpdimsparse  = jpincomax*300*24 
    3536 
    36    !                            !!!namelist variables 
     37   !                         !!** namelist variables ** 
    3738   INTEGER ::   nit000_han    ! First time step used for harmonic analysis 
    3839   INTEGER ::   nitend_han    ! Last time step used for harmonic analysis 
    3940   INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis 
    40    INTEGER ::   nb_ana           ! Number of harmonics to analyse 
     41   INTEGER ::   nb_ana        ! Number of harmonics to analyse 
    4142 
    4243   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
    … …  
    9495      READ  ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 ) 
    9596902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp ) 
    96       WRITE ( numond, nam_diaharm ) 
     97      IF(lwm) WRITE ( numond, nam_diaharm ) 
    9798      ! 
    9899      IF(lwp) THEN 
    … …  
    119120            ENDIF 
    120121         END DO 
    121       ENDDO 
     122      END DO 
    122123      ! 
    123124      IF(lwp) THEN 
    … …  
    158159      ! ---------------------------- 
    159160      ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    160       ana_temp(:,:,:,:) = 0.e0 
     161      ana_temp(:,:,:,:) = 0._wp 
    161162 
    162163   END SUBROUTINE dia_harm_init 
    … …  
    179180      IF( nn_timing == 1 )   CALL timing_start('dia_harm') 
    180181 
    181       IF ( kt == nit000 ) CALL dia_harm_init 
    182  
    183       IF ( ((kt.GE.nit000_han).AND.(kt.LE.nitend_han)).AND. & 
    184            (MOD(kt,nstep_han).EQ.0) ) THEN 
    185  
    186         ztime = (kt-nit000+1)*rdt  
     182      IF( kt == nit000 ) CALL dia_harm_init 
     183 
     184      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
     185 
     186         ztime = (kt-nit000+1) * rdt  
    187187        
    188         nhc = 0 
    189         DO jh = 1,nb_ana 
    190           DO jc = 1,2 
    191             nhc = nhc+1 
    192             ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  & 
    193                     +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
    194  
    195             DO jj = 1,jpj 
    196               DO ji = 1,jpi 
    197                 ! Elevation 
    198                 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask(ji,jj,1)         
     188         nhc = 0 
     189         DO jh = 1, nb_ana 
     190            DO jc = 1, 2 
     191               nhc = nhc+1 
     192               ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  & 
     193                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
     194 
     195               DO jj = 1, jpj 
     196                  DO ji = 1, jpi 
     197                     ! Elevation 
     198                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask(ji,jj,1) 
    199199#if defined key_dynspg_ts 
    200                 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 
    201                 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 
    202 #endif 
    203               END DO 
    204             END DO 
    205  
    206           END DO 
    207         END DO 
    208         
     200                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 
     201                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 
     202#endif 
     203                  END DO 
     204               END DO 
     205               ! 
     206            END DO 
     207         END DO 
     208         !        
    209209      END IF 
    210210 
    … …  
    249249         keq = keq + 1 
    250250         kun = 0 
    251          DO jh = 1,nb_ana 
    252             DO jc = 1,2 
     251         DO jh = 1, nb_ana 
     252            DO jc = 1, 2 
    253253               kun = kun + 1 
    254254               ksp = ksp + 1 
    … …  
    296296               out_eta(ji,jj,jh       ) = X1 * tmask(ji,jj,1) 
    297297               out_eta(ji,jj,jh+nb_ana) = X2 * tmask(ji,jj,1) 
    298             ENDDO 
    299          ENDDO 
    300       ENDDO 
     298            END DO 
     299         END DO 
     300      END DO 
    301301 
    302302      ! ubar: 
    … …  
    309309                  kun = kun + 1 
    310310                  ztmp4(kun)=ana_temp(ji,jj,kun,2) 
    311                ENDDO 
    312             ENDDO 
     311               END DO 
     312            END DO 
    313313 
    314314            CALL SUR_DETERMINE(jj+1) 
    … …  
    316316            ! Fill output array 
    317317            DO jh = 1, nb_ana 
    318                ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
    319                ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
     318               ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1) 
     319               ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2) 
    320320            END DO 
    321321 
    … …  
    326326         DO ji = 1, jpi 
    327327            DO jh = 1, nb_ana  
    328                X1=ana_amp(ji,jj,jh,1) 
    329                X2=-ana_amp(ji,jj,jh,2) 
    330                out_u(ji,jj,jh) = X1 * umask(ji,jj,1) 
    331                out_u (ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 
    332             ENDDO 
    333          ENDDO 
    334       ENDDO 
     328               X1 = ana_amp(ji,jj,jh,1) 
     329               X2 =-ana_amp(ji,jj,jh,2) 
     330               out_u(ji,jj,jh       ) = X1 * umask(ji,jj,1) 
     331               out_u(ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 
     332            END DO 
     333         END DO 
     334      END DO 
    335335 
    336336      ! vbar: 
    … …  
    343343                  kun = kun + 1 
    344344                  ztmp4(kun)=ana_temp(ji,jj,kun,3) 
    345                ENDDO 
    346             ENDDO 
     345               END DO 
     346            END DO 
    347347 
    348348            CALL SUR_DETERMINE(jj+1) 
    … …  
    364364               out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 
    365365               out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 
    366             ENDDO 
    367          ENDDO 
    368       ENDDO 
     366            END DO 
     367         END DO 
     368      END DO 
    369369 
    370370      CALL dia_wri_harm ! Write results in files 
    … …  
    437437#else 
    438438      DO jh = 1, nb_ana 
    439          CALL iom_put( TRIM(tname(jh))//'x_v', out_u(:,:,jh       ) ) 
    440          CALL iom_put( TRIM(tname(jh))//'y_v', out_u(:,:,jh+nb_ana) ) 
    441       END DO 
    442 #endif 
    443  
     439         CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) ) 
     440         CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 
     441      END DO 
     442#endif 
     443      ! 
    444444   END SUBROUTINE dia_wri_harm 
    445445 
    446446 
    447447   SUBROUTINE SUR_DETERMINE(init) 
    448    !!--------------------------------------------------------------------------------- 
    449    !!                      *** ROUTINE SUR_DETERMINE *** 
    450    !!     
    451    !!     
    452    !!        
    453    !!--------------------------------------------------------------------------------- 
    454    INTEGER, INTENT(in) ::   init  
    455    ! 
    456    INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
    457    REAL(wp)                        :: zval1, zval2, zx1 
    458    REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 
    459    INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 
    460    !--------------------------------------------------------------------------------- 
    461    CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
    462    CALL wrk_alloc( jpincomax , ipos2 , ipivot        ) 
     448      !!--------------------------------------------------------------------------------- 
     449      !!                      *** ROUTINE SUR_DETERMINE *** 
     450      !!     
     451      !!     
     452      !!        
     453      !!--------------------------------------------------------------------------------- 
     454      INTEGER, INTENT(in) ::   init  
     455      ! 
     456      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
     457      REAL(wp)                        :: zval1, zval2, zx1 
     458      REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 
     459      INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 
     460      !--------------------------------------------------------------------------------- 
     461      CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
     462      CALL wrk_alloc( jpincomax , ipos2 , ipivot        ) 
    463463             
    464    IF( init == 1 ) THEN 
    465       IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 
    466       IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 
    467       ! 
    468       ztmp3(:,:) = 0._wp 
    469       ! 
    470       DO jk1_sd = 1, nsparse 
    471          DO jk2_sd = 1, nsparse 
    472             nisparse(jk2_sd) = nisparse(jk2_sd) 
    473             njsparse(jk2_sd) = njsparse(jk2_sd) 
    474             IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
    475                ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
    476                                                         + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
    477             ENDIF 
    478          END DO 
    479       END DO 
    480  
    481       DO jj_sd = 1 ,ninco 
    482           ipos1(jj_sd) = jj_sd 
    483           ipos2(jj_sd) = jj_sd 
    484       ENDDO 
    485  
    486       DO ji_sd = 1 , ninco 
    487  
    488          !find greatest non-zero pivot: 
    489          zval1 = ABS(ztmp3(ji_sd,ji_sd)) 
    490  
    491          ipivot(ji_sd) = ji_sd 
    492          DO jj_sd = ji_sd, ninco 
    493             zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
    494             IF( zval2.GE.zval1 )THEN 
    495                ipivot(ji_sd) = jj_sd 
    496                zval1         = zval2 
    497             ENDIF 
    498          ENDDO 
    499  
    500          DO ji1_sd = 1, ninco 
    501             zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd) 
    502             zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd)) 
    503             ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd) 
    504             ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 
    505          ENDDO 
    506  
    507          ipos2(ji_sd)         = ipos1(ipivot(ji_sd)) 
    508          ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 
    509          ipos1(ji_sd)         = ipos2(ji_sd) 
    510          ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 
    511          zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd) 
    512          DO jj_sd = 1, ninco 
    513             ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 
    514          ENDDO 
    515  
     464      IF( init == 1 ) THEN 
     465         IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 
     466         IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 
     467         ! 
     468         ztmp3(:,:) = 0._wp 
     469         ! 
     470         DO jk1_sd = 1, nsparse 
     471            DO jk2_sd = 1, nsparse 
     472               nisparse(jk2_sd) = nisparse(jk2_sd) 
     473               njsparse(jk2_sd) = njsparse(jk2_sd) 
     474               IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
     475                  ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
     476                     &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
     477               ENDIF 
     478            END DO 
     479         END DO 
     480         ! 
     481         DO jj_sd = 1 ,ninco 
     482            ipos1(jj_sd) = jj_sd 
     483            ipos2(jj_sd) = jj_sd 
     484         END DO 
     485         ! 
     486         DO ji_sd = 1 , ninco 
     487            ! 
     488            !find greatest non-zero pivot: 
     489            zval1 = ABS(ztmp3(ji_sd,ji_sd)) 
     490            ! 
     491            ipivot(ji_sd) = ji_sd 
     492            DO jj_sd = ji_sd, ninco 
     493               zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
     494               IF( zval2.GE.zval1 )THEN 
     495                  ipivot(ji_sd) = jj_sd 
     496                  zval1         = zval2 
     497               ENDIF 
     498            END DO 
     499            ! 
     500            DO ji1_sd = 1, ninco 
     501               zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd) 
     502               zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd)) 
     503               ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd) 
     504               ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 
     505            END DO 
     506            ! 
     507            ipos2(ji_sd)         = ipos1(ipivot(ji_sd)) 
     508            ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 
     509            ipos1(ji_sd)         = ipos2(ji_sd) 
     510            ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 
     511            zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd) 
     512            DO jj_sd = 1, ninco 
     513               ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 
     514            END DO 
     515            ! 
     516            DO ji2_sd = ji_sd+1, ninco 
     517               zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 
     518               DO jj_sd=1,ninco 
     519                  ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 
     520               END DO 
     521            END DO 
     522            ! 
     523         END DO 
     524         ! 
     525      ENDIF ! End init==1 
     526 
     527      DO ji_sd = 1, ninco 
     528         ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 
    516529         DO ji2_sd = ji_sd+1, ninco 
    517             zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 
    518             DO jj_sd=1,ninco 
    519                ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 
    520             ENDDO 
    521          ENDDO 
    522  
    523       ENDDO 
    524  
    525    ENDIF ! End init==1 
    526  
    527    DO ji_sd = 1, ninco 
    528       ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 
    529       DO ji2_sd = ji_sd+1, ninco 
    530          ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 
    531       ENDDO 
    532    ENDDO 
    533  
    534    !system solving:  
    535    ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 
    536    ji_sd = ninco 
    537    DO ji_sd = ninco-1, 1, -1 
    538       zx1=0. 
    539       DO jj_sd = ji_sd+1, ninco 
    540          zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 
    541       ENDDO 
    542       ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 
    543    ENDDO 
    544  
    545    DO jj_sd =1, ninco 
    546       ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 
    547    ENDDO 
    548  
    549    CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
    550    CALL wrk_dealloc( jpincomax , ipos2 , ipivot        ) 
    551  
    552   END SUBROUTINE SUR_DETERMINE 
     530            ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 
     531         END DO 
     532      END DO 
     533 
     534      !system solving:  
     535      ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 
     536      ji_sd = ninco 
     537      DO ji_sd = ninco-1, 1, -1 
     538         zx1 = 0._wp 
     539         DO jj_sd = ji_sd+1, ninco 
     540            zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 
     541         END DO 
     542         ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 
     543      END DO 
     544 
     545      DO jj_sd =1, ninco 
     546         ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 
     547      END DO 
     548 
     549      CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
     550      CALL wrk_dealloc( jpincomax , ipos2 , ipivot        ) 
     551      ! 
     552   END SUBROUTINE SUR_DETERMINE 
    553553 
    554554#else 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4558 r4792  
    221221      READ  ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 
    222222902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 
    223       WRITE ( numond, namhsb ) 
     223      IF(lwm) WRITE ( numond, namhsb ) 
    224224 
    225225      ! 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r4292 r4792  
    467467      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    468468902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
    469       WRITE ( numond, namptr ) 
     469      IF(lwm) WRITE ( numond, namptr ) 
    470470 
    471471      IF(lwp) THEN                     ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4570 r4792  
    4545   USE diadimg         ! dimg direct access file format output 
    4646   USE diaar5, ONLY :   lk_diaar5 
    47    USE dynadv, ONLY :   ln_dynadv_vec 
    4847   USE iom 
    4948   USE ioipsl 
    … …  
    131130      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    132131      !! 
    133       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d       ! 2D workspace 
     132      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
     133      REAL(wp), POINTER, DIMENSION(:,:)   :: z2ds     ! 2D workspace 
    134134      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
    135135      !!---------------------------------------------------------------------- 
    … …  
    137137      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    138138      !  
    139       CALL wrk_alloc( jpi , jpj      , z2d ) 
     139      CALL wrk_alloc( jpi , jpj      , z2d , z2ds ) 
    140140      CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    141141      ! 
    … …  
    193193      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    194194 
     195      ! clem: heat and salt content 
     196      z2d(:,:)  = 0._wp  
     197      z2ds(:,:) = 0._wp  
     198      DO jk = 1, jpkm1 
     199         DO jj = 2, jpjm1 
     200            DO ji = fs_2, fs_jpim1   ! vector opt. 
     201               z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     202               z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     203            END DO 
     204         END DO 
     205      END DO 
     206      CALL lbc_lnk( z2d, 'T', 1. ) 
     207      CALL lbc_lnk( z2ds, 'T', 1. ) 
     208      CALL iom_put( "heatc", z2d )    ! vertically integrated heat content (J/m2) 
     209      CALL iom_put( "saltc", z2ds )   ! vertically integrated salt content (PSU*kg/m2) 
     210       
     211 
    195212      IF( lk_diaar5 ) THEN 
    196213         z3d(:,:,jpk) = 0.e0 
    197214         DO jk = 1, jpkm1 
    198             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 
     215            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
    199216         END DO 
    200217         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     218 
    201219         zztmp = 0.5 * rcp 
    202220         z2d(:,:) = 0.e0  
     221         z2ds(:,:) = 0.e0  
    203222         DO jk = 1, jpkm1 
    204223            DO jj = 2, jpjm1 
    205224               DO ji = fs_2, fs_jpim1   ! vector opt. 
    206225                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     226                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    207227               END DO 
    208228            END DO 
    209229         END DO 
    210230         CALL lbc_lnk( z2d, 'U', -1. ) 
     231         CALL lbc_lnk( z2ds, 'U', -1. ) 
    211232         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
     233         CALL iom_put( "u_salttr", z2ds )                 ! salt transport in i-direction 
     234 
     235         z3d(:,:,jpk) = 0.e0 
    212236         DO jk = 1, jpkm1 
    213             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 
     237            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
    214238         END DO 
    215239         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     240 
    216241         z2d(:,:) = 0.e0  
     242         z2ds(:,:) = 0.e0  
    217243         DO jk = 1, jpkm1 
    218244            DO jj = 2, jpjm1 
    219245               DO ji = fs_2, fs_jpim1   ! vector opt. 
    220246                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     247                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
    221248               END DO 
    222249            END DO 
    223250         END DO 
    224251         CALL lbc_lnk( z2d, 'V', -1. ) 
    225          CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction 
    226       ENDIF 
    227       ! 
    228       CALL wrk_dealloc( jpi , jpj      , z2d ) 
     252         CALL lbc_lnk( z2ds, 'V', -1. ) 
     253         CALL iom_put( "v_heattr", z2d )                  !  heat transport in j-direction 
     254         CALL iom_put( "v_salttr", z2ds )                 !  salt transport in j-direction 
     255      ENDIF 
     256      ! 
     257      CALL wrk_dealloc( jpi , jpj      , z2d , z2ds ) 
    229258      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    230259      ! 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r4488 r4792  
    153153   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    154154   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
     155   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 
    155156 
    156157   !!---------------------------------------------------------------------- 
    … …  
    329330      ierr(:) = 0 
    330331      ! 
    331       ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     332      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  & 
     333         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 
    332334         ! 
    333335      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r4490 r4792  
    159159      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    160160902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
    161       WRITE ( numond, namrun ) 
     161      IF(lwm) WRITE ( numond, namrun ) 
    162162      ! 
    163163      IF(lwp) THEN                  ! control print 
    … …  
    241241      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
    242242904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
    243       WRITE ( numond, namdom ) 
     243      IF(lwm) WRITE ( numond, namdom ) 
    244244 
    245245      IF(lwp) THEN 
    … …  
    303303      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
    304304906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
    305       WRITE( numond, namcla ) 
     305      IF(lwm) WRITE( numond, namcla ) 
    306306 
    307307      IF(lwp) THEN 
    … …  
    327327      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
    328328908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
    329       WRITE( numond, namnc4 ) 
     329      IF(lwm) WRITE( numond, namnc4 ) 
    330330 
    331331      IF(lwp) THEN                        ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r4245 r4792  
    8282      !!---------------------------------------------------------------------- 
    8383      !                              ! recalculate jpizoom/jpjzoom given lat/lon 
    84       IF( lk_c1d )  CALL dom_c1d( rn_lat1d, rn_lon1d ) 
     84      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d ) 
    8585      ! 
    8686      !                        ! ============== ! 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r4328 r4792  
    152152      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 ) 
    153153902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp ) 
    154       WRITE ( numond, namlbc ) 
     154      IF(lwm) WRITE ( numond, namlbc ) 
    155155       
    156156      IF(lwp) THEN                  ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r4490 r4792  
    922922      READ  ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 ) 
    923923902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp ) 
    924       WRITE ( numond, nam_vvl ) 
     924      IF(lwm) WRITE ( numond, nam_vvl ) 
    925925 
    926926      IF(lwp) THEN                    ! Namelist print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r4292 r4792  
    113113      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    114114902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    115       WRITE ( numond, namzgr ) 
     115      IF(lwm) WRITE ( numond, namzgr ) 
    116116 
    117117      IF(lwp) THEN                     ! Control print 
    … …  
    11401140      READ  ( numnam_cfg, namzgr_sco, IOSTAT = ios, ERR = 902 ) 
    11411141902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist', lwp ) 
    1142       WRITE ( numond, namzgr_sco ) 
     1142      IF(lwm) WRITE ( numond, namzgr_sco ) 
    11431143 
    11441144      IF(lwp) THEN                           ! control print 
    … …  
    14451445            DO jk = 1, jpkm1 
    14461446               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
    1447                IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0 
    1448             END DO 
     1447            END DO 
     1448            IF( scobot(ji,jj) == 0._wp               )   mbathy(ji,jj) = 0 
    14491449         END DO 
    14501450      END DO 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r4292 r4792  
    7777      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 
    7878902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 
    79       WRITE ( numond, namtsd ) 
     79      IF(lwm) WRITE ( numond, namtsd ) 
    8080 
    8181      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3625 r4792  
    5454   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
    5555   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
    56    REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
    57    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     56   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/kg/K] 
     57   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [kg.K/J] 
    5858   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5959 
    … …  
    6969#if defined key_lim3 || defined key_cice 
    7070   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    71    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    72    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    73    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     71   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     72   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K]  
     73   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice                                 [J/kg/K] 
    7474   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7575   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    76    REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
     76   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity          [degC/ppt] 
    7777   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    7878#else 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90

    r4147 r4792  
    101101      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    102102902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
    103       WRITE ( numond, namdyn_adv ) 
     103      IF(lwm) WRITE ( numond, namdyn_adv ) 
    104104 
    105105      IF(lwp) THEN                    ! Namelist print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r4292 r4792  
    135135      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 
    136136902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 
    137       WRITE ( numond, namdyn_hpg ) 
     137      IF(lwm) WRITE ( numond, namdyn_hpg ) 
    138138      ! 
    139139      IF(lwp) THEN                   ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

    r4372 r4792  
    125125      READ  ( numnam_cfg, namdyn_nept, IOSTAT = ios, ERR = 902 ) 
    126126902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_nept in configuration namelist', lwp ) 
    127       WRITE ( numond, namdyn_nept ) 
     127      IF(lwm) WRITE ( numond, namdyn_nept ) 
    128128 
    129129      IF(lwp) THEN                      ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4496 r4792  
    4444   USE agrif_opa_interp ! agrif 
    4545#endif 
    46  
     46#if defined key_asminc    
     47   USE asminc          ! Assimilation increment 
     48#endif 
    4749 
    4850   IMPLICIT NONE 
    … …  
    290292      ! 
    291293      DO jk = 1, jpkm1 
    292 #if defined key_vectopt_loop 
    293          DO jj = 1, 1         !Vector opt. => forced unrolling 
    294             DO ji = 1, jpij 
    295 #else  
    296          DO jj = 1, jpj 
    297             DO ji = 1, jpi 
    298 #endif                                                                    
    299                zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    300                zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)          
    301             END DO 
    302          END DO 
     294         zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     295         zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
    303296      END DO 
    304297      ! 
    … …  
    464457      !                                             ! ==================== !   
    465458      ! Initialize barotropic variables:       
     459      IF( ll_init )THEN 
     460         sshbb_e(:,:) = 0._wp 
     461         ubb_e  (:,:) = 0._wp 
     462         vbb_e  (:,:) = 0._wp 
     463         sshb_e (:,:) = 0._wp 
     464         ub_e   (:,:) = 0._wp 
     465         vb_e   (:,:) = 0._wp 
     466      ENDIF 
     467      ! 
    466468      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    467469         sshn_e(:,:) = sshn (:,:)             
    … …  
    10621064      READ  ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 
    10631065902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 
    1064       WRITE ( numond, namsplit ) 
     1066      IF(lwm) WRITE ( numond, namsplit ) 
    10651067      ! 
    10661068      !         ! Max courant number for ext. grav. waves 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4601 r4792  
    725725      READ  ( numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902 ) 
    726726902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_vor in configuration namelist', lwp ) 
    727       WRITE ( numond, namdyn_vor ) 
     727      IF(lwm) WRITE ( numond, namdyn_vor ) 
    728728 
    729729      IF(lwp) THEN                    ! Namelist print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90

    r4147 r4792  
    9696      READ  ( numnam_cfg, namflo, IOSTAT = ios, ERR = 902 ) 
    9797902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namflo in configuration namelist', lwp ) 
    98       WRITE ( numond, namflo ) 
     98      IF(lwm) WRITE ( numond, namflo ) 
    9999      ! 
    100100      IF(lwp) THEN                  ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r4153 r4792  
    363363      READ  ( numnam_cfg, namberg, IOSTAT = ios, ERR = 902 ) 
    364364902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namberg in configuration namelist', lwp ) 
    365       WRITE ( numond, namberg ) 
     365      IF(lwm) WRITE ( numond, namberg ) 
    366366#else 
    367367      IF(lwp) THEN 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r4147 r4792  
    138138   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    139139   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
    140    LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only 
     140   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always) 
     141   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
    141142   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
    142143 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4292 r4792  
    3232   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    3333   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes 
     34#if defined key_lim3 
     35   USE par_ice 
     36#elif defined key_lim2 
     37   USE par_ice_2 
     38#endif 
    3439   USE domngb          ! ocean space and time domain 
    3540   USE phycst          ! physical constants 
    … …  
    4954#endif 
    5055   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    51    PUBLIC iom_getatt, iom_context_finalize 
     56   PUBLIC iom_getatt, iom_use, iom_context_finalize 
    5257 
    5358   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    6368   END INTERFACE 
    6469   INTERFACE iom_getatt 
    65       MODULE PROCEDURE iom_g0d_intatt 
     70      MODULE PROCEDURE iom_g0d_intatt, iom_g0d_ratt 
    6671   END INTERFACE 
    6772   INTERFACE iom_rstput 
    … …  
    143148      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    144149# endif 
     150#if defined key_lim3 || defined key_lim2 
     151      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
     152#endif 
    145153      CALL iom_set_axis_attr( "icbcla", class_num ) 
    146154       
    … …  
    344352            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' ) 
    345353            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file 
     354         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to  
     355            clname = cltmpn       ! overwrite so get back the file name without the cpu number 
    346356         ENDIF 
    347357      ENDIF 
    … …  
    896906   !!                   INTERFACE iom_getatt 
    897907   !!---------------------------------------------------------------------- 
    898    SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar ) 
     908   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar, cdvar ) 
    899909      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    900910      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
    901       INTEGER         , INTENT(  out)                 ::   pvar      ! read field 
     911      INTEGER         , INTENT(  out)                 ::   pvar      ! written field 
     912      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
    902913      ! 
    903914      IF( kiomid > 0 ) THEN 
    … …  
    905916            SELECT CASE (iom_file(kiomid)%iolib) 
    906917            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
    907             CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     918            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pv_i0d=pvar ) 
    908919            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
    909920            CASE DEFAULT     
    … …  
    914925   END SUBROUTINE iom_g0d_intatt 
    915926 
     927   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar ) 
     928      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     929      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     930      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field 
     931      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     932      ! 
     933      IF( kiomid > 0 ) THEN 
     934         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     935            SELECT CASE (iom_file(kiomid)%iolib) 
     936            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
     937            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     938                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar, cdvar=cdvar ) 
     939                                   ELSE 
     940                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar ) 
     941                                   ENDIF 
     942            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
     943            CASE DEFAULT     
     944               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     945            END SELECT 
     946         ENDIF 
     947      ENDIF 
     948   END SUBROUTINE iom_g0d_ratt 
    916949 
    917950   !!---------------------------------------------------------------------- 
    … …  
    10131046      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    10141047      REAL(wp)        , INTENT(in) ::   pfield0d 
     1048      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    10151049#if defined key_iomput 
    1016       CALL xios_send_field(cdname, (/pfield0d/)) 
     1050      zz(:,:)=pfield0d 
     1051      CALL xios_send_field(cdname, zz) 
     1052      !CALL xios_send_field(cdname, (/pfield0d/))  
    10171053#else 
    10181054      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    12051241      !! 
    12061242      !!---------------------------------------------------------------------- 
    1207       REAL(wp), DIMENSION(1,1) ::   zz = 1. 
     1243      REAL(wp), DIMENSION(1) ::   zz = 1. 
    12081244      !!---------------------------------------------------------------------- 
    12091245      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    1210       CALL iom_set_domain_attr('scalarpoint', data_dim=1) 
    1211       CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 
     1246      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
     1247      zz=REAL(narea,wp) 
     1248      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    12121249 
    12131250   END SUBROUTINE set_scalar 
    … …  
    14971534 
    14981535#endif 
     1536 
     1537   LOGICAL FUNCTION iom_use( cdname ) 
     1538      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     1539#if defined key_iomput 
     1540      iom_use = xios_field_is_active( cdname ) 
     1541#else 
     1542      iom_use = .FALSE. 
     1543#endif 
     1544   END FUNCTION iom_use 
    14991545    
    15001546   !!====================================================================== 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r4292 r4792  
    3535   END INTERFACE 
    3636   INTERFACE iom_nf90_getatt 
    37       MODULE PROCEDURE iom_nf90_intatt 
     37      MODULE PROCEDURE iom_nf90_att 
    3838   END INTERFACE 
    3939   INTERFACE iom_nf90_rstput 
    … …  
    217217         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
    218218         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
    219          iom_file(kiomid)%dimsz(:,kiv) = 0   ! reset dimsz in case previously used 
     219         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used 
    220220         DO ji = 1, i_nvd                       ! dimensions size 
    221221            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
    … …  
    312312 
    313313 
    314    SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar ) 
    315       !!----------------------------------------------------------------------- 
    316       !!                  ***  ROUTINE  iom_nf90_intatt  *** 
     314   SUBROUTINE iom_nf90_att( kiomid, cdatt, pv_i0d, pv_r0d, cdvar) 
     315      !!----------------------------------------------------------------------- 
     316      !!                  ***  ROUTINE  iom_nf90_att  *** 
    317317      !! 
    318318      !! ** Purpose : read an integer attribute with NF90 
    … …  
    320320      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file 
    321321      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name 
    322       INTEGER         , INTENT(  out) ::   pvar     ! read field 
     322      INTEGER         , INTENT(  out), OPTIONAL       ::   pv_i0d    ! read field 
     323      REAL(wp),         INTENT(  out), OPTIONAL       ::   pv_r0d    ! read field  
     324      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! name of the variable 
    323325      ! 
    324326      INTEGER                         ::   if90id   ! temporary integer 
     327      INTEGER                         ::   ivarid           ! NetCDF  variable Id 
    325328      LOGICAL                         ::   llok     ! temporary logical 
    326329      CHARACTER(LEN=100)              ::   clinfo   ! info character 
    … …  
    328331      !  
    329332      if90id = iom_file(kiomid)%nfid 
    330       llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     333      IF( PRESENT(cdvar) ) THEN 
     334         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file 
     335         IF( llok ) THEN 
     336            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr 
     337         ELSE 
     338            CALL ctl_warn('iom_nf90_getatt: no variable '//cdvar//' found') 
     339         ENDIF 
     340      ELSE 
     341         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     342      ENDIF  
     343! 
    331344      IF( llok) THEN 
    332345         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 
    333          CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo) 
     346         IF(     PRESENT(pv_r0d) ) THEN 
     347            IF( PRESENT(cdvar) ) THEN 
     348               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 
     349            ELSE 
     350               CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_r0d), clinfo) 
     351            ENDIF 
     352         ELSE 
     353            IF( PRESENT(cdvar) ) THEN 
     354               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 
     355            ELSE 
     356               CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pv_i0d), clinfo) 
     357            ENDIF 
     358         ENDIF 
    334359      ELSE 
    335360         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
    336          pvar = -999 
     361         IF(     PRESENT(pv_r0d) ) THEN 
     362            pv_r0d = -999._wp 
     363         ELSE 
     364            pv_i0d = -999 
     365         ENDIF 
    337366      ENDIF 
    338367      !  
    339    END SUBROUTINE iom_nf90_intatt 
     368   END SUBROUTINE iom_nf90_att 
    340369 
    341370 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4334 r4792  
    120120                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    121121                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
     122      IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    122123                     ! 
    123124                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    … …  
    210211         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    211212         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
     213         IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    212214      ELSE 
    213215         neuler = 0 
    … …  
    245247         hdivb(:,:,:)   = hdivn(:,:,:) 
    246248         sshb (:,:)     = sshn (:,:) 
    247       ENDIF 
    248       ! 
    249       IF( lk_lim3 ) THEN  
     249         IF( lk_lim3 ) THEN 
     250            DO jk = 1, jpk 
     251               fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     252            END DO 
     253         ENDIF 
     254      ENDIF 
     255      ! 
     256      IF( lk_lim3 ) THEN 
    250257         CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 
    251258         CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4230 r4792  
    3333 
    3434   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3 
    35    INTEGER, PUBLIC                                  ::   nsndto 
     35   INTEGER, PUBLIC                                  ::   nsndto, nfsloop, nfeloop 
    3636   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate 
    3737 
    … …  
    412412            SELECT CASE ( cd_type ) 
    413413            CASE ( 'T' , 'W' )                         ! T-, W-point 
    414                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     414               IF (nimpp .ne. 1) THEN 
    415415                 startloop = 1 
    416416               ELSE 
    … …  
    420420               DO jk = 1, jpk 
    421421                  DO ji = startloop, nlci 
    422                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     422                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    423423                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    424424                  END DO 
     425                  IF(nimpp .eq. 1) THEN 
     426                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 
     427                  ENDIF 
    425428               END DO 
    426429 
    … …  
    435438                 DO jk = 1, jpk 
    436439                    DO ji = startloop, nlci 
    437                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     440                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    438441                       jia = ji + nimpp - 1 
    439442                       ijta = jpiglo - jia + 2 
    … …  
    448451 
    449452 
    450  
    451453            CASE ( 'U' )                               ! U-point 
    452                IF (narea .ne. (jpnij)) THEN 
     454               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    453455                  endloop = nlci 
    454456               ELSE 
    … …  
    457459               DO jk = 1, jpk 
    458460                  DO ji = 1, endloop 
    459                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     461                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    460462                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    461463                  END DO 
    462                END DO 
    463  
    464                IF (narea .ne. (jpnij)) THEN 
     464                  IF(nimpp .eq. 1) THEN 
     465                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk) 
     466                  ENDIF 
     467                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     468                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 
     469                  ENDIF 
     470               END DO 
     471 
     472               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    465473                  endloop = nlci 
    466474               ELSE 
    … …  
    477485                 DO jk = 1, jpk 
    478486                    DO ji = startloop, endloop 
    479                       iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     487                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    480488                      jia = ji + nimpp - 1 
    481489                      ijua = jpiglo - jia + 1 
    … …  
    490498 
    491499            CASE ( 'V' )                               ! V-point 
    492                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     500               IF (nimpp .ne. 1) THEN 
    493501                  startloop = 1 
    494502               ELSE 
    … …  
    497505               DO jk = 1, jpk 
    498506                  DO ji = startloop, nlci 
    499                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     507                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    500508                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    501509                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
    502510                  END DO 
     511                  IF(nimpp .eq. 1) THEN 
     512                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 
     513                  ENDIF 
    503514               END DO 
    504515            CASE ( 'F' )                               ! F-point 
    505                IF (narea .ne. (jpnij)) THEN 
     516               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    506517                  endloop = nlci 
    507518               ELSE 
    … …  
    510521               DO jk = 1, jpk 
    511522                  DO ji = 1, endloop 
    512                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     523                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    513524                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    514525                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
    515526                  END DO 
     527                  IF(nimpp .eq. 1) THEN 
     528                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk) 
     529                  ENDIF 
     530                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     531                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 
     532                  ENDIF 
    516533               END DO 
    517534            END SELECT 
    … …  
    524541               DO jk = 1, jpk 
    525542                  DO ji = 1, nlci 
    526                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     543                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    527544                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
    528545                  END DO 
    … …  
    530547 
    531548            CASE ( 'U' )                               ! U-point 
    532                IF (narea .ne. (jpnij)) THEN 
     549               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    533550                  endloop = nlci 
    534551               ELSE 
    … …  
    537554               DO jk = 1, jpk 
    538555                  DO ji = 1, endloop 
    539                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     556                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    540557                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
    541558                  END DO 
     559                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     560                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 
     561                  ENDIF 
    542562               END DO 
    543563 
    … …  
    545565               DO jk = 1, jpk 
    546566                  DO ji = 1, nlci 
    547                      ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 3 
     567                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
    548568                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    549569                  END DO 
    … …  
    560580                 DO jk = 1, jpk 
    561581                    DO ji = startloop, nlci 
    562                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     582                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    563583                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    564584                    END DO 
    … …  
    567587 
    568588            CASE ( 'F' )                               ! F-point 
    569                IF (narea .ne. (jpnij)) THEN 
     589               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    570590                  endloop = nlci 
    571591               ELSE 
    … …  
    574594               DO jk = 1, jpk 
    575595                  DO ji = 1, endloop 
    576                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     596                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    577597                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    578598                  END DO 
    579                END DO 
    580  
    581                IF (narea .ne. (jpnij)) THEN 
     599                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     600                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 
     601                  ENDIF 
     602               END DO 
     603 
     604               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    582605                  endloop = nlci 
    583606               ELSE 
    … …  
    594617                  DO jk = 1, jpk 
    595618                     DO ji = startloop, endloop 
    596                         iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     619                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    597620                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    598621                     END DO 
    … …  
    656679         ! 
    657680         CASE ( 'T' , 'W' )                               ! T- , W-points 
    658             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     681            IF (nimpp .ne. 1) THEN 
    659682              startloop = 1 
    660683            ELSE 
    … …  
    662685            ENDIF 
    663686            DO ji = startloop, nlci 
    664               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     687              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    665688              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    666689            END DO 
     690            IF (nimpp .eq. 1) THEN 
     691              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2) 
     692            ENDIF 
    667693 
    668694            IF(nimpp .ge. (jpiglo/2+1)) THEN 
    … …  
    674700            ENDIF 
    675701            DO ji = startloop, nlci 
    676                ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     702               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    677703               jia = ji + nimpp - 1 
    678704               ijta = jpiglo - jia + 2 
    … …  
    685711 
    686712         CASE ( 'U' )                                     ! U-point 
    687             IF (narea .ne. (jpnij)) THEN 
     713            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    688714               endloop = nlci 
    689715            ELSE 
    … …  
    691717            ENDIF 
    692718            DO ji = 1, endloop 
    693                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     719               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    694720               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    695721            END DO 
    696722 
    697             IF (narea .ne. (jpnij)) THEN 
     723            IF (nimpp .eq. 1) THEN 
     724              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2) 
     725              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 
     726            ENDIF 
     727            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     728              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2) 
     729            ENDIF 
     730 
     731            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    698732               endloop = nlci 
    699733            ELSE 
    … …  
    708742            ENDIF 
    709743            DO ji = startloop, endloop 
    710                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     744               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    711745               jia = ji + nimpp - 1 
    712746               ijua = jpiglo - jia + 1 
    … …  
    719753 
    720754         CASE ( 'V' )                                     ! V-point 
    721             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     755            IF (nimpp .ne. 1) THEN 
    722756              startloop = 1 
    723757            ELSE 
    … …  
    725759            ENDIF 
    726760            DO ji = startloop, nlci 
    727               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     761              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    728762              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
    729763              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
    730764            END DO 
     765            IF (nimpp .eq. 1) THEN 
     766              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3)  
     767            ENDIF 
    731768 
    732769         CASE ( 'F' )                                     ! F-point 
    733             IF (narea .ne. (jpnij)) THEN 
     770            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    734771               endloop = nlci 
    735772            ELSE 
    … …  
    737774            ENDIF 
    738775            DO ji = 1, endloop 
    739                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     776               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    740777               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
    741778               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
    742779            END DO 
     780            IF (nimpp .eq. 1) THEN 
     781              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3) 
     782              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2) 
     783            ENDIF 
     784            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     785              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3) 
     786              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)  
     787            ENDIF 
    743788 
    744789         CASE ( 'I' )                                     ! ice U-V point (I-point) 
    745             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     790            IF (nimpp .ne. 1) THEN 
    746791               startloop = 1 
    747792            ELSE 
    … …  
    750795            ENDIF 
    751796            DO ji = startloop, nlci 
    752                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     797               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    753798               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    754799            END DO 
    755800 
    756801         CASE ( 'J' )                                     ! first ice U-V point 
    757             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     802            IF (nimpp .ne. 1) THEN 
    758803               startloop = 1 
    759804            ELSE 
    … …  
    762807            ENDIF 
    763808            DO ji = startloop, nlci 
    764                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     809               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    765810               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    766811            END DO 
    767812 
    768813         CASE ( 'K' )                                     ! second ice U-V point 
    769             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     814            IF (nimpp .ne. 1) THEN 
    770815               startloop = 1 
    771816            ELSE 
    … …  
    774819            ENDIF 
    775820            DO ji = startloop, nlci 
    776                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     821               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    777822               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    778823            END DO 
    … …  
    785830         CASE ( 'T' , 'W' )                               ! T-, W-point 
    786831            DO ji = 1, nlci 
    787                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     832               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    788833               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
    789834            END DO 
    790835 
    791836         CASE ( 'U' )                                     ! U-point 
    792             IF (narea .ne. (jpnij)) THEN 
     837            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    793838               endloop = nlci 
    794839            ELSE 
    … …  
    796841            ENDIF 
    797842            DO ji = 1, endloop 
    798                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     843               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    799844               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    800845            END DO 
     846            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     847               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 
     848            ENDIF 
    801849 
    802850         CASE ( 'V' )                                     ! V-point 
    803851            DO ji = 1, nlci 
    804                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     852               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    805853               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    806854            END DO 
    … …  
    813861            ENDIF 
    814862            DO ji = startloop, nlci 
    815                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     863               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    816864               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    817865            END DO 
    818866 
    819867         CASE ( 'F' )                               ! F-point 
    820             IF (narea .ne. (jpnij)) THEN 
     868            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    821869               endloop = nlci 
    822870            ELSE 
    … …  
    824872            ENDIF 
    825873            DO ji = 1, endloop 
    826                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     874               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    827875               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    828876            END DO 
    829  
    830             IF (narea .ne. (jpnij)) THEN 
     877            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     878                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 
     879            ENDIF 
     880 
     881            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    831882               endloop = nlci 
    832883            ELSE 
    … …  
    842893 
    843894            DO ji = startloop, endloop 
    844                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     895               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    845896               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    846897            END DO 
    847898 
    848899         CASE ( 'I' )                                  ! ice U-V point (I-point) 
    849                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     900               IF (nimpp .ne. 1) THEN 
    850901                  startloop = 1 
    851902               ELSE 
    852903                  startloop = 2 
    853904               ENDIF 
    854                IF (narea .ne. jpnij) THEN 
     905               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    855906                  endloop = nlci 
    856907               ELSE 
    … …  
    858909               ENDIF 
    859910               DO ji = startloop , endloop 
    860                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     911                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    861912                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    862913               END DO 
    863914 
    864915         CASE ( 'J' )                                  ! first ice U-V point 
    865                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     916               IF (nimpp .ne. 1) THEN 
    866917                  startloop = 1 
    867918               ELSE 
    868919                  startloop = 2 
    869920               ENDIF 
    870                IF (narea .ne. jpnij) THEN 
     921               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    871922                  endloop = nlci 
    872923               ELSE 
    … …  
    874925               ENDIF 
    875926               DO ji = startloop , endloop 
    876                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     927                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    877928                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
    878929               END DO 
    879930 
    880931         CASE ( 'K' )                                  ! second ice U-V point 
    881                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     932               IF (nimpp .ne. 1) THEN 
    882933                  startloop = 1 
    883934               ELSE 
    884935                  startloop = 2 
    885936               ENDIF 
    886                IF (narea .ne. jpnij) THEN 
     937               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    887938                  endloop = nlci 
    888939               ELSE 
    … …  
    890941               ENDIF 
    891942               DO ji = startloop, endloop 
    892                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     943                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    893944                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
    894945               END DO 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4328 r4792  
    170170      INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist 
    171171      INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist 
    172       INTEGER                      , INTENT(in   ) ::   kumond         ! logical unit for namelist output 
     172      INTEGER                      , INTENT(inout) ::   kumond         ! logical unit for namelist output 
    173173      INTEGER                      , INTENT(inout) ::   kstop          ! stop indicator 
    174174      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm 
    … …  
    193193      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    194194902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
    195       WRITE(kumond, nammpp)       
    196195 
    197196      !                              ! control print 
    … …  
    293292      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    294293      mynode = mpprank 
     294 
     295      IF( mynode == 0 ) THEN 
     296        CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
     297        WRITE(kumond, nammpp)       
     298      ENDIF 
    295299      ! 
    296300      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr) 
    … …  
    20222026      ijpjm1 = 3 
    20232027      ! 
     2028      znorthloc(:,:,:) = 0 
    20242029      DO jk = 1, jpk 
    20252030         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
    … …  
    20322037      itaille = jpi * jpk * ijpj 
    20332038 
    2034  
    20352039      IF ( l_north_nogather ) THEN 
    20362040         ! 
    20372041        ztabr(:,:,:) = 0 
     2042        ztabl(:,:,:) = 0 
     2043 
    20382044        DO jk = 1, jpk 
    20392045           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    20402046              ij = jj - nlcj + ijpj 
    2041               DO ji = 1, nlci 
     2047              DO ji = nfsloop, nfeloop 
    20422048                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    20432049              END DO 
    … …  
    20462052 
    20472053         DO jr = 1,nsndto 
    2048             IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 
     2054            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2055              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     2056            ENDIF 
    20492057         END DO 
    20502058         DO jr = 1,nsndto 
    2051             iproc = isendto(jr) 
    2052             ildi = nldit (iproc) 
    2053             ilei = nleit (iproc) 
    2054             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2055             IF(isendto(jr) .ne. narea) THEN 
    2056               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2059            iproc = nfipproc(isendto(jr),jpnj) 
     2060            IF(iproc .ne. -1) THEN 
     2061               ilei = nleit (iproc+1) 
     2062               ildi = nldit (iproc+1) 
     2063               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2064            ENDIF 
     2065            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2066              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    20572067              DO jk = 1, jpk 
    20582068                 DO jj = 1, ijpj 
    2059                     DO ji = 1, ilei 
     2069                    DO ji = ildi, ilei 
    20602070                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    20612071                    END DO 
    20622072                 END DO 
    20632073              END DO 
    2064            ELSE 
     2074           ELSE IF (iproc .eq. (narea-1)) THEN 
    20652075              DO jk = 1, jpk 
    20662076                 DO jj = 1, ijpj 
    2067                     DO ji = 1, ilei 
     2077                    DO ji = ildi, ilei 
    20682078                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    20692079                    END DO 
    … …  
    20742084         IF (l_isend) THEN 
    20752085            DO jr = 1,nsndto 
    2076                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2086               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2087                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2088               ENDIF     
    20772089            END DO 
    20782090         ENDIF 
    20792091         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2080          ! 
    20812092         DO jk = 1, jpk 
    20822093            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    … …  
    21262137      ! Either way the array may be folded by lbc_nfd and the result for the span of 
    21272138      ! this domain will be identical. 
    2128       ! 
    2129       CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
    2130       ! 
    2131       DO jk = 1, jpk 
    2132          DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    2133             ij = jj - nlcj + ijpj 
    2134             DO ji= 1, nlci 
    2135                pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk) 
    2136             END DO 
    2137         END DO 
    2138       END DO 
    21392139      ! 
    21402140      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
    … …  
    21972197         ! 
    21982198         ztabr(:,:) = 0 
     2199         ztabl(:,:) = 0 
     2200 
    21992201         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    22002202            ij = jj - nlcj + ijpj 
    2201             DO ji = 1, nlci 
     2203              DO ji = nfsloop, nfeloop 
    22022204               ztabl(ji,ij) = pt2d(ji,jj) 
    22032205            END DO 
    … …  
    22052207 
    22062208         DO jr = 1,nsndto 
    2207             IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2209            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2210               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2211            ENDIF 
    22082212         END DO 
    22092213         DO jr = 1,nsndto 
    2210             iproc = isendto(jr) 
    2211             ildi = nldit (iproc) 
    2212             ilei = nleit (iproc) 
    2213             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2214             IF(isendto(jr) .ne. narea) THEN 
    2215               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2214            iproc = nfipproc(isendto(jr),jpnj) 
     2215            IF(iproc .ne. -1) THEN 
     2216               ilei = nleit (iproc+1) 
     2217               ildi = nldit (iproc+1) 
     2218               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2219            ENDIF 
     2220            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2221              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    22162222              DO jj = 1, ijpj 
    2217                  DO ji = 1, ilei 
     2223                 DO ji = ildi, ilei 
    22182224                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    22192225                 END DO 
    22202226              END DO 
    2221             ELSE 
     2227            ELSE IF (iproc .eq. (narea-1)) THEN 
    22222228              DO jj = 1, ijpj 
    2223                  DO ji = 1, ilei 
     2229                 DO ji = ildi, ilei 
    22242230                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    22252231                 END DO 
    … …  
    22292235         IF (l_isend) THEN 
    22302236            DO jr = 1,nsndto 
    2231                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2237               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2238                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2239               ENDIF 
    22322240            END DO 
    22332241         ENDIF 
    … …  
    29242932      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0 
    29252933      IF( .FALSE. )   ldtxt(:) = 'never done' 
     2934      CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    29262935   END FUNCTION mynode 
    29272936 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r3294 r4792  
    177177       
    178178#endif 
     179      nfilcit(:,:) = ilcit(:,:) 
    179180      IF( irestj == 0 )   irestj = jpnj 
    180181 
    … …  
    255256         END DO 
    256257      ENDIF 
     258      nfiimpp(:,:)=iimppt(:,:) 
    257259 
    258260      IF( jpnj > 1 ) THEN 
    … …  
    270272         ii = 1 + MOD( jn-1, jpni ) 
    271273         ij = 1 + (jn-1) / jpni 
     274         nfipproc(ii,ij) = jn - 1 
    272275         nimppt(jn) = iimppt(ii,ij) 
    273276         njmppt(jn) = ijmppt(ii,ij) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r4153 r4792  
    8686      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    8787902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    88       WRITE ( numond, namzgr ) 
     88      IF(lwm) WRITE ( numond, namzgr ) 
    8989 
    9090      IF(lwp)WRITE(numout,*) 
    … …  
    144144#endif 
    145145 
     146      nfilcit(:,:) = ilci(:,:) 
     147 
    146148      IF(lwp) WRITE(numout,*) 
    147149      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' 
    … …  
    175177         END DO 
    176178      ENDIF 
     179      nfiimpp(:,:) = iimppt(:,:) 
    177180 
    178181      IF( jpnj > 1 )THEN 
    … …  
    195198         ili = ilci(ii,ij) 
    196199         ilj = ilcj(ii,ij) 
    197  
    198200         ibondj(ii,ij) = -1 
    199201         IF( jarea >  jpni          )   ibondj(ii,ij) = 0 
    200202         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1 
    201203         IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
    202  
    203204         ibondi(ii,ij) = 0 
    204205         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1 
    … …  
    284285            IF( jarea > ijm1 ) ipolj(ii,ij) = 3 
    285286            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4 
    286             IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1   ! MPI rank of northern neighbour 
     287            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour 
    287288         ENDIF 
    288289         IF( jperio == 5 .OR. jperio == 6 ) THEN 
    … …  
    291292            IF( jarea > ijm1) ipolj(ii,ij) = 5 
    292293            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6 
    293             IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1    ! MPI rank of northern neighbour 
     294            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour 
    294295         ENDIF 
    295296 
    … …  
    307308         ENDIF 
    308309      END DO 
     310 
     311      nfipproc(:,:) = ipproc(:,:) 
     312 
    309313 
    310314      ! Control 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r4292 r4792  
    8181      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 ) 
    8282902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist', lwp ) 
    83       WRITE ( numond, namdyn_ldf ) 
     83      IF(lwm) WRITE ( numond, namdyn_ldf ) 
    8484 
    8585      IF(lwp) THEN                      ! Parameter print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r4147 r4792  
    8585      READ  ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 
    8686902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 
    87       WRITE ( numond, namtra_ldf ) 
     87      IF(lwm) WRITE ( numond, namtra_ldf ) 
    8888 
    8989      IF(lwp) THEN                      ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r4292 r4792  
    208208      !----------------------------------------------------------------------- 
    209209 
     210      !Initalise all values in namelist arrays 
     211      enactfiles(:) = '' 
     212      coriofiles(:) = '' 
     213      profbfiles(:) = '' 
     214      slafilesact(:) = '' 
     215      slafilespas(:) = '' 
     216      slafbfiles(:) = '' 
     217      sstfiles(:)   = '' 
     218      sstfbfiles(:) = '' 
     219      seaicefiles(:) = '' 
    210220      velcurfiles(:) = '' 
    211221      veladcpfiles(:) = '' 
     222      velavcurfiles(:) = '' 
     223      velhrcurfiles(:) = '' 
     224      velavadcpfiles(:) = '' 
     225      velhradcpfiles(:) = '' 
     226      velfbfiles(:) = '' 
     227      velcurfiles(:) = '' 
     228      veladcpfiles(:) = '' 
     229      endailyavtypes(:) = -1 
     230      endailyavtypes(1) = 820 
     231      ln_profb_ena(:) = .FALSE. 
     232      ln_profb_enatim(:) = .TRUE. 
     233      ln_velfb_av(:) = .FALSE. 
     234      ln_ignmis = .FALSE. 
    212235      CALL ini_date( dobsini ) 
    213236      CALL fin_date( dobsend ) 
    … …  
    221244      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    222245902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp ) 
    223       WRITE ( numond, namobs ) 
     246      IF(lwm) WRITE ( numond, namobs ) 
    224247 
    225248      ! Count number of files for each type 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r4147 r4792  
    212212      READ  ( numnam_cfg, namsbc_alb, IOSTAT = ios, ERR = 902 ) 
    213213902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in configuration namelist', lwp ) 
    214       WRITE ( numond, namsbc_alb ) 
     214      IF(lwm) WRITE ( numond, namsbc_alb ) 
    215215      ! 
    216216      IF(lwp) THEN                      ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r4694 r4792  
    4040      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    4141      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
    42       CHARACTER(len = 34) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
     42      CHARACTER(len = 256) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    4343      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    4444      !                                     ! a string starting with "U" or "V" for each component    
    … …  
    489489            !       forcing record :    1  
    490490            !                             
    491             ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 
     491            ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 
     492           &       + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 
    492493            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    493494            ! swap at the middle of the year 
    494             IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 
    495             ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)    
     495            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 
     496                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1)  
     497            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 
     498                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2)  
    496499            ENDIF 
    497500         ELSE                                    ! no time interpolation 
    … …  
    517520            !       forcing record :  nmonth  
    518521            !                             
    519             ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 
     522            ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 
     523           &       + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 
    520524            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    521525            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    … …  
    689693      !!---------------------------------------------------------------------- 
    690694#if defined key_bdy 
    691       USE bdy_oce, ONLY:  dta_global, dta_global2         ! workspace to read in global data arrays 
     695      USE bdy_oce, ONLY:  dta_global, dta_global_z, dta_global2, dta_global2_z         ! workspace to read in global data arrays 
    692696#endif  
    693697      INTEGER                   , INTENT(in ) ::   num     ! stream number 
    … …  
    706710      INTEGER                                 ::   ib, ik, ji, jj   ! loop counters 
    707711      INTEGER                                 ::   ierr 
     712      REAL(wp)                                ::   fv ! fillvalue and alternative -ABS(fv) 
    708713      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read    ! work space for global data 
    709714      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_z  ! work space for global data 
    … …  
    753758         END SELECT 
    754759         CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar ) 
     760#if defined key_bdy 
    755761         CALL fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
     762#endif 
    756763      ELSE ! boundary data assumed to be on model grid 
    757764         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )                     
    … …  
    776783   END SUBROUTINE fld_map 
    777784    
     785#if defined key_bdy 
    778786   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
    779787 
    … …  
    784792      !!                boundary data from non-native vertical grid 
    785793      !!---------------------------------------------------------------------- 
    786 #if defined key_bdy 
    787794      USE bdy_oce, ONLY:  idx_bdy         ! indexing for map <-> ij transformation 
    788 #endif  
    789795 
    790796      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read    ! work space for global data 
    … …  
    792798      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta        ! output field on model grid (2 dimensional) 
    793799      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map        ! global-to-local mapping indices 
    794       INTEGER  , INTENT(in)                   ::   igrd, ib_bdy, jpk_bdy      ! number of levels in bdy data 
     800      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy      ! number of levels in bdy data 
    795801      INTEGER                                 ::   jpkm1_bdy    ! number of levels in bdy data minus 1 
     802      REAL(wp) , INTENT(in)                                ::   fv ! fillvalue and alternative -ABS(fv) 
    796803      !! 
    797804      INTEGER                                 ::   ipi        ! length of boundary data on local process 
    … …  
    800807      INTEGER                                 ::   ilendta    ! length of data in file 
    801808      INTEGER                                 ::   ib, ik, ikk! loop counters 
     809      INTEGER                                 ::   ji, jj ! loop counters 
    802810      REAL(wp)                                ::   zl, zi     ! tmp variable for current depth and interpolation factor 
    803       REAL(wp)                                ::   fv, fv_alt ! fillvalue and alternative -ABS(fv) 
     811      REAL(wp)                                ::   fv_alt ! fillvalue and alternative -ABS(fv) 
    804812      !!--------------------------------------------------------------------- 
    805813 
    … …  
    824832         DO ib = 1, ipi 
    825833            DO ik = 1, ipk                       
    826                zl =  gdept_1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_1? 
     834               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
    827835               IF( zl < dta_read_z(map(ib),1,1) ) THEN                                         ! above the first level of external data 
    828836                  dta(ib,1,ik) =  dta_read(map(ib),1,1) 
    … …  
    830838                  dta(ib,1,ik) =  dta_read(map(ib),1,MAXLOC(dta_read_z(map(ib),1,:),1)) 
    831839               ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1 
    832                   DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_1(ikk) < zl < gdept_1(ikk+1) 
     840                  DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_0(ikk) < zl < gdept_0(ikk+1) 
    833841                     IF( ( (zl-dta_read_z(map(ib),1,ikk)) * (zl-dta_read_z(map(ib),1,ikk+1)) <= 0._wp)   & 
    834842                    &    .AND. (dta_read_z(map(ib),1,ikk+1) /= fv_alt)) THEN 
    … …  
    857865            ji=map(ib)-(jj-1)*ilendta 
    858866            DO ik = 1, ipk                       
    859                zl =  gdept_1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_1? 
     867               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
    860868               IF( zl < dta_read_z(ji,jj,1) ) THEN                                         ! above the first level of external data 
    861                   dta(ib,1,ik) =  dta_read(ji,jj,1,1) 
     869                  dta(ib,1,ik) =  dta_read(ji,jj,1) 
    862870               ELSEIF( zl > MAXVAL(dta_read_z(ji,ji,:),1) ) THEN                           ! below the last level of external data  
    863871                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 
    864872               ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1 
    865                   DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_1(ikk) < zl < gdept_1(ikk+1) 
     873                  DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_0(ikk) < zl < gdept_0(ikk+1) 
    866874                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp)   & 
    867875                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 
    868876                        zi = ( zl - dta_read_z(ji,jj,ikk) ) / (dta_read_z(ji,jj,ikk+1)-dta_read_z(ji,jj,ikk)) 
    869877                        dta(ib,1,ik) = dta_read(ji,jj,ikk) + & 
    870                       &                ( dta_read(ji,jj,1,ikk+1) -  dta_read(ji,jj,ikk) ) * zi 
     878                      &                ( dta_read(ji,jj,ikk+1) -  dta_read(ji,jj,ikk) ) * zi 
    871879                     ENDIF 
    872880                  END DO 
    … …  
    877885 
    878886   END SUBROUTINE fld_bdy_interp 
     887#endif 
    879888 
    880889   SUBROUTINE fld_rot( kt, sd ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r4604 r4792  
    8181         READ  ( numnam_cfg, namsbc_ana, IOSTAT = ios, ERR = 902 ) 
    8282902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ana in configuration namelist', lwp ) 
    83          WRITE ( numond, namsbc_ana ) 
     83         IF(lwm) WRITE ( numond, namsbc_ana ) 
    8484         ! 
    8585         IF(lwp) WRITE(numout,*)' ' 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r4328 r4792  
    8383         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
    8484902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
    85          WRITE ( numond, namsbc_apr ) 
     85         IF(lwm) WRITE ( numond, namsbc_apr ) 
    8686         ! 
    8787         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r4147 r4792  
    148148         READ  ( numnam_cfg, namsbc_clio, IOSTAT = ios, ERR = 902 ) 
    149149902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_clio in configuration namelist', lwp ) 
    150          WRITE ( numond, namsbc_clio ) 
     150         IF(lwm) WRITE ( numond, namsbc_clio ) 
    151151 
    152152         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4333 r4792  
    154154902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in configuration namelist', lwp ) 
    155155 
    156          WRITE ( numond, namsbc_core ) 
     156         IF(lwm) WRITE ( numond, namsbc_core ) 
    157157         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    158158         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &  
    … …  
    563563      zcoef_dqsb   = rhoa * cpa * Cice 
    564564      zcoef_frca   = 1.0  - 0.3 
     565      ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
     566      zcoef_frca   = 1.0  - 0.19 
    565567 
    566568!!gm brutal.... 
    … …  
    648650               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    649651               ! Long  Wave (lw) 
    650                ! iovino 
    651                IF( ff(ji,jj) .GT. 0._wp ) THEN 
    652                   z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    653                ELSE 
    654                   z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    655                ENDIF 
     652               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    656653               ! lw sensitivity 
    657654               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    668665                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    669666               ! Latent heat sensitivity for ice (Dqla/Dt) 
    670                p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     667               ! MV we also have to cap the sensitivity if the flux is zero 
     668               IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     669                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     670               ELSE 
     671                  p_dqla(ji,jj,jl) = 0.0 
     672               ENDIF 
     673                              
    671674               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    672675               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    820823           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
    821824         ELSE 
    822            !! Shifting the wind speed to 10m and neutral stability : 
    823            U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a) 
     825           !! Shifting the wind speed to 10m and neutral stability :  L & Y eq. (9a) 
     826           !   In very rare low-wind conditions, the old way of estimating the 
     827           !   neutral wind speed at 10m leads to a negative value that causes the code 
     828           !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     829           U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    824830 
    825831           !! Updating the neutral 10m transfer coefficients : 
    … …  
    956962         zpsi_m  = psi_m(zeta_u) 
    957963         !! 
    958          !! Shifting the wind speed to 10m and neutral stability : (L & Y eq.(9a)) 
    959 !        U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u))) 
    960          U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) 
     964         !! Shifting the wind speed to 10m and neutral stability : L & Y eq.(9a) 
     965         !   In very rare low-wind conditions, the old way of estimating the 
     966         !   neutral wind speed at 10m leads to a negative value that causes the code 
     967         !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     968         U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    961969         !! 
    962970         !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c)) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r4147 r4792  
    141141         READ  ( numnam_cfg, namsbc_mfs, IOSTAT = ios, ERR = 902 ) 
    142142902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_mfs in configuration namelist', lwp ) 
    143          WRITE ( numond, namsbc_mfs ) 
     143         IF(lwm) WRITE ( numond, namsbc_mfs ) 
    144144         ! 
    145145         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4393 r4792  
    244244      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 
    245245902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
    246       WRITE ( numond, namsbc_cpl ) 
     246      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    247247 
    248248      IF(lwp) THEN                        ! control print 
    … …  
    13741374            END SELECT 
    13751375         CASE( 'mixed oce-ice'        )    
    1376             ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1376            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    13771377            DO jl=1,jpl 
    13781378               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r4147 r4792  
    9898         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 
    9999902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist', lwp ) 
    100          WRITE ( numond, namsbc_flx )  
     100         IF(lwm) WRITE ( numond, namsbc_flx )  
    101101         ! 
    102102         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r4347 r4792  
    5757      !!                =1 global mean of emp set to zero at each nn_fsbc time step 
    5858      !!                =2 annual global mean corrected from previous year 
     59      !!                =3 global mean of emp set to zero at each nn_fsbc time step 
     60      !!                   & spread out over erp area depending its sign 
    5961      !! Note: if sea ice is embedded it is taken into account when computing the budget  
    6062      !!---------------------------------------------------------------------- 
    … …  
    8183            IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero' 
    8284            IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget' 
    83          ENDIF 
     85            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area' 
     86         ENDIF 
     87         ! 
     88         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 
    8489         ! 
    8590         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
    … …  
    142147         ENDIF 
    143148         ! 
     149      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==! 
     150         ! 
     151         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
     152            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp 
     153            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp 
     154            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
     155            ! 
     156            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
     157            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
     158            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
     159            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
     160            !             
     161            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
     162                zsurf_tospread      = zsurf_pos 
     163                ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
     164            ELSE                             ! spread out over <0 erp area to increase precipitation 
     165                zsurf_tospread      = zsurf_neg 
     166                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
     167            ENDIF 
     168            ! 
     169            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     170!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
     171            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
     172            !                                                  ! weight to respect erp field 2D structure  
     173            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     174            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
     175            !                                                  ! final correction term to apply 
     176            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 
     177            ! 
     178!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
     179            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
     180            ! 
     181            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     182            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     183            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
     184            ! 
     185            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     186               IF( z_fwf < 0._wp ) THEN 
     187                  WRITE(numout,*)'   z_fwf < 0' 
     188                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     189               ELSE 
     190                  WRITE(numout,*)'   z_fwf >= 0' 
     191                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     192               ENDIF 
     193               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
     194               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     195               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     196               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  
     197               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)  
     198            ENDIF 
     199         ENDIF 
     200         ! 
    144201      CASE DEFAULT                           !==  you should never be there  ==! 
    145          CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' ) 
     202         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 
    146203         ! 
    147204      END SELECT 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r4292 r4792  
    6060   PUBLIC sbc_ice_cice    ! routine called by sbc 
    6161 
    62    INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
    63    INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
     62   INTEGER             ::   ji_off 
     63   INTEGER             ::   jj_off 
    6464 
    6565   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    … …  
    158158      IF(lwp) WRITE(numout,*)'cice_sbc_init' 
    159159 
     160      ji_off = INT ( (jpiglo - nx_global) / 2 ) 
     161      jj_off = INT ( (jpjglo - ny_global) / 2 ) 
     162 
    160163! Initialize CICE 
    161164      CALL CICE_Initialize 
    … …  
    220223         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    221224         ! 
    222          ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
    223          !       which were previously set in domvvl 
    224          IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
    225             DO jj = 1, jpjm1 
    226                DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
    227                   zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
    228                   zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
    229                   zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
    230                   sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
    231                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
    232                   sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
    233                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
    234                   sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
    235                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
    236                   sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
    237                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
    238                END DO 
    239             END DO 
    240             CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
    241             CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
    242             DO jj = 1, jpjm1 
    243                DO ji = 1, jpim1      ! NO Vector Opt. 
    244                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    245                        &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    246                        &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    247                        &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    248                END DO 
    249             END DO 
    250             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    251           ENDIF 
    252225      ENDIF 
    253226  
    … …  
    747720         READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 ) 
    748721902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist', lwp ) 
    749          WRITE ( numond, namsbc_cice ) 
     722         IF(lwm) WRITE ( numond, namsbc_cice ) 
    750723 
    751724         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4161 r4792  
    7878         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 ) 
    7979902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist', lwp ) 
    80          WRITE ( numond, namsbc_iif ) 
     80         IF(lwm) WRITE ( numond, namsbc_iif ) 
    8181 
    8282         ALLOCATE( sf_ice(1), STAT=ierror ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4333 r4792  
    5959   USE prtctl          ! Print control 
    6060   USE lib_fortran     !  
     61   USE cpl_oasis3, ONLY : lk_cpl 
    6162 
    6263#if defined key_bdy  
    … …  
    6869 
    6970   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90 
     71   PUBLIC lim_prt_state 
    7072    
    7173   !! * Substitutions 
    … …  
    133135      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    134136      !! 
    135       INTEGER  ::   jl      ! dummy loop index 
     137      INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
    136138      REAL(wp) ::   zcoef   ! local scalar 
    137139      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
    … …  
    146148      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
    147149      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
     150      REAL(wp) ::   ztmelts           ! clem 2014: for HC diags 
     151      REAL(wp) ::   epsi20 = 1.e-20   ! 
    148152      !!---------------------------------------------------------------------- 
    149153 
    … …  
    152156      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    153157 
    154       CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    155  
    156 #if defined key_coupled 
    157       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 
    158       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    159          &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    160 #endif 
     158      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     159 
     160      IF( lk_cpl ) THEN 
     161         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     162            &   CALL wrk_alloc( jpi, jpj, ztem_ice_all , zalb_ice_all  , z_qsr_ice_all, z_qns_ice_all,  & 
     163            &                            z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     164      ENDIF 
    161165 
    162166      IF( kt == nit000 ) THEN 
    … …  
    168172         ! 
    169173         IF( ln_nicep ) THEN      ! control print at a given point 
    170             jiindx = 177   ;   jjindx = 112 
     174            jiindx = 15    ;   jjindx =  44 
    171175            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    172176         ENDIF 
    … …  
    176180      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    177181         !                                     !----------------------! 
    178          !                                           !  Bulk Formulea ! 
     182         !                                           !  Bulk Formulae ! 
    179183         !                                           !----------------! 
    180184         ! 
    181185         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point 
    182186         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
    183          ! 
    184          t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin] 
    185          !                                           ! (set to rt0 over land) 
     187 
     188         ! masked sea surface freezing temperature [Kelvin] 
     189         t_bo(:,:) = ( tfreez( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) 
     190 
    186191         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo 
    187192 
    … …  
    192197         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
    193198          
    194 #if defined key_coupled 
    195          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    196             ! 
    197             ! Compute mean albedo and temperature 
    198             zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
    199             ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
    200             ! 
     199         IF( lk_cpl ) THEN 
     200            IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     201               ! 
     202               ! Compute mean albedo and temperature 
     203               zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
     204               ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
     205               ! 
     206            ENDIF 
    201207         ENDIF 
    202 #endif 
    203208                                               ! Bulk formulea - provides the following fields: 
    204209         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
    … …  
    218223            !          
    219224         CASE( 4 )                                       ! CORE bulk formulation 
    220             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               & 
     225            ! MV 2014 
     226            ! We must account for cloud fraction in the computation of the albedo 
     227            ! The present ref just uses the clear sky value 
     228            ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 
     229            ! CORE has no cloud fraction, hence we must prescribe it 
     230            ! Mean summer cloud fraction computed from CLIO = 0.81 
     231            zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 
     232            ! Following line, we replace zalb_ice_cs by simply zalb_ice 
     233            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    221234               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    222235               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    … …  
    239252 
    240253         ! Average over all categories 
    241 #if defined key_coupled 
     254         IF( lk_cpl ) THEN 
    242255         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    243256 
    … …  
    269282            END IF 
    270283         END IF 
    271 #endif 
     284         ENDIF 
    272285         !                                           !----------------------! 
    273286         !                                           ! LIM-3  time-stepping ! 
    … …  
    285298         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content 
    286299         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    287          ! 
    288          old_u_ice(:,:) = u_ice(:,:) 
    289          old_v_ice(:,:) = v_ice(:,:) 
    290          !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
     300         old_u_ice(:,:)     = u_ice(:,:) 
     301         old_v_ice(:,:)     = v_ice(:,:) 
     302 
     303         ! trends    !!gm is it truly necessary ??? 
    291304         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
    292305         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
    … …  
    296309         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
    297310         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
    298          ! 
    299          d_u_ice_dyn(:,:) = 0._wp 
    300          d_v_ice_dyn(:,:) = 0._wp 
    301          ! 
    302          sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 0._wp 
    303          sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
    304          fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
    305          fhmec  (:,:) = 0._wp   ;    
    306          fmmec  (:,:) = 0._wp 
    307          fmmflx (:,:) = 0._wp      
    308          focea2D(:,:) = 0._wp 
    309          fsup2D (:,:) = 0._wp 
    310  
    311          ! used in limthd.F90 
    312          rdvosif(:,:) = 0._wp   ! variation of ice volume at surface 
    313          rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom 
    314          fdvolif(:,:) = 0._wp   ! total variation of ice volume 
    315          rdvonif(:,:) = 0._wp   ! lateral variation of ice volume 
    316          fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
    317          ffltbif(:,:) = 0._wp   ! linked with fstric 
    318          qfvbq  (:,:) = 0._wp   ! linked with fstric 
    319          rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area 
    320          rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area 
    321          hicifp (:,:) = 0._wp   ! daily thermodynamic ice production.  
    322          ! 
    323          diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
    324          diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
    325          diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    326          diag_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp 
     311         d_u_ice_dyn(:,:)     = 0._wp   ;   d_v_ice_dyn(:,:)     = 0._wp 
     312 
     313         ! salt, heat and mass fluxes 
     314         sfx    (:,:) = 0._wp   ; 
     315         sfx_bri(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp  
     316         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     317         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     318         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     319         sfx_res(:,:) = 0._wp 
     320 
     321         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     322         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     323         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     324         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     325         wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     326         wfx_spr(:,:) = 0._wp   ;    
     327 
     328         hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
     329         hfx_thd(:,:) = 0._wp   ;    
     330         hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     331         hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
     332         hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
     333         hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
     334         hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
     335         hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     336 
     337         ! 
     338         fhld  (:,:)    = 0._wp  
     339         fmmflx(:,:)    = 0._wp      
     340         ! part of solar radiation transmitted through the ice 
     341         ftr_ice(:,:,:) = 0._wp 
     342 
     343         ! diags 
     344         diag_trp_vi  (:,:) = 0._wp  ; diag_trp_vs(:,:) = 0._wp  ;  diag_trp_ei(:,:) = 0._wp  ;  diag_trp_es(:,:) = 0._wp 
     345         diag_heat_dhc(:,:) = 0._wp   
     346 
    327347         ! dynamical invariants 
    328348         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    … …  
    375395                          zcoef = rdt_ice /rday           !  Ice natural aging 
    376396                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    377                           CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
    378397         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
    379398                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
    … …  
    391410         !                                           ! Diagnostics and outputs  
    392411         IF (ln_limdiaout) CALL lim_diahsb 
    393 !clem # if ! defined key_iomput 
     412 
    394413                          CALL lim_wri( 1  )              ! Ice outputs  
    395 !clem # endif 
     414 
    396415         IF( kt == nit000 .AND. ln_rstart )   & 
    397416            &             CALL iom_close( numrir )        ! clem: close input ice restart file 
    … …  
    413432       
    414433!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    415       ! 
    416       CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    417  
    418 #if defined key_coupled 
    419       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 
    420       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    421          &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    422 #endif 
     434      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     435 
     436      IF( lk_cpl ) THEN 
     437         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     438            &    CALL wrk_dealloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all,   & 
     439            &                                z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     440      ENDIF 
    423441      ! 
    424442      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    … …  
    534552!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    535553!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    536 !                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl) 
    537554!                 WRITE(numout,*)  
    538555                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    591608               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    592609               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    593                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) 
    594                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) 
    595                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice 
    596                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice 
    597                !WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj) 
    598                !WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj) 
    599                !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 
    600                !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 
    601                !WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    602                !WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    603                !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    604                !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    605                !WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
    606610               ! 
    607611               !CALL lim_prt_state( kt, ji, jj, 2, '   ') 
    … …  
    790794               WRITE(numout,*) ' - Heat / FW fluxes ' 
    791795               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    792                WRITE(numout,*) ' emp        : ', emp      (ji,jj) 
    793                WRITE(numout,*) ' sfx        : ', sfx      (ji,jj) 
    794                WRITE(numout,*) ' sfx_thd    : ', sfx_thd(ji,jj) 
    795                WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ji,jj) 
    796                WRITE(numout,*) ' sfx_mec    : ', sfx_mec  (ji,jj) 
    797                WRITE(numout,*) ' sfx_res    : ', sfx_res(ji,jj) 
    798                WRITE(numout,*) ' fmmec      : ', fmmec    (ji,jj) 
    799                WRITE(numout,*) ' fhmec      : ', fhmec    (ji,jj) 
    800                WRITE(numout,*) ' fhbri      : ', fhbri    (ji,jj) 
    801                WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ji,jj) 
     796               WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 
     797               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( old_a_i(ji,jj,:) * qsr_ice(ji,jj,:) ) 
     798               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( old_a_i(ji,jj,:) * qns_ice(ji,jj,:) ) 
     799               WRITE(numout,*) 
    802800               WRITE(numout,*)  
    803801               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
    … …  
    829827               WRITE(numout,*) ' qsr       : ', qsr(ji,jj) 
    830828               WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    831                WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
    832                WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) * r1_rdtice 
    833                WRITE(numout,*) ' qldif     : ', qldif(ji,jj) * r1_rdtice 
     829               WRITE(numout,*) 
     830               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
     831               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
     832               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
     833               WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)               
     834               WRITE(numout,*) 
     835               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
     836               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
     837               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
     838               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
     839               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    834840               WRITE(numout,*) 
    835841               WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    836842               WRITE(numout,*) ' emp       : ', emp    (ji,jj) 
    837                WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
    838843               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj) 
    839844               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj) 
    840                WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ji,jj) 
    841                WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    842                WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
     845               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
     846               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj) 
    843847               WRITE(numout,*) 
    844848               WRITE(numout,*) ' - Momentum fluxes ' 
    845849               WRITE(numout,*) ' utau      : ', utau(ji,jj)  
    846850               WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    847             ENDIF 
     851            ENDIF  
    848852            WRITE(numout,*) ' ' 
    849853            ! 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4621 r4792  
    5353   USE agrif_lim2_update 
    5454# endif 
     55 
     56#if defined key_bdy  
     57   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     58#endif 
    5559 
    5660   IMPLICIT NONE 
    … …  
    205209                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion ) 
    206210           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
     211#if defined key_bdy 
     212                           CALL bdy_ice_lim( kt ) ! bdy ice thermo 
     213#endif 
    207214         END IF 
    208215#if defined key_coupled 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4607 r4792  
    101101      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    102102902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    103       WRITE ( numond, namsbc ) 
     103      IF(lwm) WRITE ( numond, namsbc ) 
    104104 
    105105      !                          ! overwrite namelist parameter using CPP key information 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r4368 r4792  
    263263      READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 ) 
    264264902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp ) 
    265       WRITE ( numond, namsbc_rnf ) 
     265      IF(lwm) WRITE ( numond, namsbc_rnf ) 
    266266      ! 
    267267      !                                         ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4147 r4792  
    174174      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 
    175175902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
    176       WRITE ( numond, namsbc_ssr ) 
     176      IF(lwm) WRITE ( numond, namsbc_ssr ) 
    177177 
    178178      IF(lwp) THEN                 !* control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r4292 r4792  
    9090         READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    9191902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp ) 
    92          WRITE ( numond, namsbc_wave ) 
     92         IF(lwm) WRITE ( numond, namsbc_wave ) 
    9393         ! 
    9494 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r4292 r4792  
    7272       READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 
    7373902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 
    74        WRITE ( numond, nam_tide ) 
     74       IF(lwm) WRITE ( numond, nam_tide ) 
    7575       ! 
    7676       nb_harmo=0 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90

    r4147 r4792  
    7070      READ  ( numnam_cfg, namsol, IOSTAT = ios, ERR = 902 ) 
    7171902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsol in configuration namelist', lwp ) 
    72       WRITE ( numond, namsol ) 
     72      IF(lwm) WRITE ( numond, namsol ) 
    7373 
    7474      IF(lwp) THEN                  !* Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4292 r4792  
    723723      READ  ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 
    724724902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 
    725       WRITE( numond, nameos ) 
     725      IF(lwm) WRITE( numond, nameos ) 
    726726      ! 
    727727      IF(lwp) THEN                ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r4292 r4792  
    176176      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 
    177177902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 
    178       WRITE ( numond, namtra_adv ) 
     178      IF(lwm) WRITE ( numond, namtra_adv ) 
    179179 
    180180      IF(lwp) THEN                    ! Namelist print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r4325 r4792  
    285285      READ  ( numnam_cfg, namtra_adv_mle, IOSTAT = ios, ERR = 902 ) 
    286286902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv_mle in configuration namelist', lwp ) 
    287       WRITE ( numond, namtra_adv_mle ) 
     287      IF(lwm) WRITE ( numond, namtra_adv_mle ) 
    288288 
    289289      IF(lwp) THEN                     ! Namelist print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r4147 r4792  
    141141      READ  ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 
    142142902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 
    143       WRITE ( numond, nambbc ) 
     143      IF(lwm) WRITE ( numond, nambbc ) 
    144144 
    145145      IF(lwp) THEN                     ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4292 r4792  
    577577      READ  ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 
    578578902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 
    579       WRITE ( numond, nambbl ) 
     579      IF(lwm) WRITE ( numond, nambbl ) 
    580580      ! 
    581581      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r4292 r4792  
    205205      READ  ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 
    206206902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 
    207       WRITE ( numond, namtra_dmp ) 
     207      IF(lwm) WRITE ( numond, namtra_dmp ) 
    208208       
    209209      IF( lzoom .AND. .NOT. lk_c1d )   nn_zdmp = 0          ! restoring to climatology at closed north or south boundaries 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4333 r4792  
    399399      READ  ( numnam_cfg, namtra_qsr, IOSTAT = ios, ERR = 902 ) 
    400400902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist', lwp ) 
    401       WRITE ( numond, namtra_qsr ) 
     401      IF(lwm) WRITE ( numond, namtra_qsr ) 
    402402      ! 
    403403      IF(lwp) THEN                ! control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r4147 r4792  
    266266         READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 
    267267902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 
    268          WRITE ( numond, namtrd ) 
     268         IF(lwm) WRITE ( numond, namtrd ) 
    269269 
    270270         IF(lwp) THEN 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r4381 r4792  
    203203      READ  ( numnam_cfg, nambfr, IOSTAT = ios, ERR = 902 ) 
    204204902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambfr in configuration namelist', lwp ) 
    205       WRITE ( numond, nambfr ) 
     205      IF(lwm) WRITE ( numond, nambfr ) 
    206206      IF(lwp) WRITE(numout,*) 
    207207      IF(lwp) WRITE(numout,*) 'zdf_bfr_init : momentum bottom friction' 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4147 r4792  
    223223      READ  ( numnam_cfg, namzdf_ddm, IOSTAT = ios, ERR = 902 ) 
    224224902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in configuration namelist', lwp ) 
    225       WRITE ( numond, namzdf_ddm ) 
     225      IF(lwm) WRITE ( numond, namzdf_ddm ) 
    226226      ! 
    227227      IF(lwp) THEN                    ! Parameter print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r4147 r4792  
    948948      READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 ) 
    949949902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist', lwp ) 
    950       WRITE ( numond, namzdf_gls ) 
     950      IF(lwm) WRITE ( numond, namzdf_gls ) 
    951951 
    952952      IF(lwp) THEN                     !* Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r4292 r4792  
    6464      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 ) 
    6565902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in configuration namelist', lwp ) 
    66       WRITE ( numond, namzdf ) 
     66      IF(lwm) WRITE ( numond, namzdf ) 
    6767 
    6868      IF(lwp) THEN               !* Parameter print 
    … …  
    121121      IF(lwp) WRITE(numout,*) 
    122122      IF(lwp) WRITE(numout,*) '   convection :' 
     123      ! 
     124      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working',   & 
     125         &                                       ' set ln_zdfnpc to FALSE' ) 
     126      ! 
    123127      ioptio = 0 
    124128      IF( ln_zdfnpc ) THEN 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r4147 r4792  
    13991399      READ  ( numnam_cfg, namzdf_kpp, IOSTAT = ios, ERR = 902 ) 
    14001400902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_kpp in configuration namelist', lwp ) 
    1401       WRITE ( numond, namzdf_kpp ) 
     1401      IF(lwm) WRITE ( numond, namzdf_kpp ) 
    14021402 
    14031403      IF(lwp) THEN                    ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r4147 r4792  
    260260      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 ) 
    261261902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist', lwp ) 
    262       WRITE ( numond, namzdf_ric ) 
     262      IF(lwm) WRITE ( numond, namzdf_ric ) 
    263263      ! 
    264264      IF(lwp) THEN                   ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4147 r4792  
    707707      READ  ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 ) 
    708708902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist', lwp ) 
    709       WRITE ( numond, namzdf_tke ) 
     709      IF(lwm) WRITE ( numond, namzdf_tke ) 
    710710      ! 
    711711      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r4147 r4792  
    377377      READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 ) 
    378378902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp ) 
    379       WRITE ( numond, namzdf_tmx ) 
     379      IF(lwm) WRITE ( numond, namzdf_tmx ) 
    380380 
    381381      IF(lwp) THEN                   ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4354 r4792  
    8686   USE sbctide, ONLY: lk_tide 
    8787   USE crsini          ! initialise grid coarsening utility 
    88    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     88   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8989 
    9090   IMPLICIT NONE 
    … …  
    240240      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    241241      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    242       CALL ctl_opn( numond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 
    243242      ! 
    244243      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
    … …  
    249248      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    250249902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    251       WRITE( numond, namctl ) 
    252250 
    253251      ! 
    … …  
    259257      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    260258904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    261       WRITE( numond, namcfg ) 
    262259 
    263260! Force values for AGRIF zoom (cf. agrif_user.F90) 
    … …  
    279276      !                             !--------------------------------------------! 
    280277      !                             !  set communicator & select the local node  ! 
     278      !                             !  NB: mynode also opens output.namelist.dyn ! 
     279      !                             !      on unit number numond on first proc   ! 
    281280      !                             !--------------------------------------------! 
    282281#if defined key_iomput 
    … …  
    303302      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    304303 
     304      lwm = (narea == 1)                                    ! control of output namelists 
    305305      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
     306 
     307      IF(lwm) THEN 
     308         ! write merged namelists from earlier to output namelist now that the 
     309         ! file has been opened in call to mynode. nammpp has already been 
     310         ! written in mynode (if lk_mpp_mpi) 
     311         WRITE( numond, namctl ) 
     312         WRITE( numond, namcfg ) 
     313      ENDIF 
    306314 
    307315      ! If dimensions of processor grid weren't specified in the namelist file 
    … …  
    560568      ENDIF 
    561569      ! 
    562       IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   & 
    563          &                                               'with the IOM Input/Output manager. '         ,   & 
    564          &                                               'Compile with key_iomput enabled' ) 
    565       ! 
    566570      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    567571         &                                               'f2003 standard. '                              ,  & 
    … …  
    586590      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist 
    587591      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist 
    588       IF( numond          /= -1 )   CLOSE( numond          )   ! oce output namelist 
     592      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist 
    589593      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist 
    590594      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist 
    591       IF( numoni          /= -1 )   CLOSE( numoni          )   ! ice output namelist 
     595      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist 
    592596      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution) 
    593597      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file 
    … …  
    795799          !loop over the other north-fold processes to find the processes 
    796800          !managing the points belonging to the sxT-dxT range 
    797           DO jn = jpnij - jpni +1, jpnij 
    798              IF ( njmppt(jn) == njmppmax ) THEN 
     801   
     802          DO jn = 1, jpni 
    799803                !sxT is the first point (in the global domain) of the jn 
    800804                !process 
    801                 sxT = nimppt(jn) 
     805                sxT = nfiimpp(jn, jpnj) 
    802806                !dxT is the last point (in the global domain) of the jn 
    803807                !process 
    804                 dxT = nimppt(jn) + nlcit(jn) - 1 
     808                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    805809                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    806810                   nsndto = nsndto + 1 
    807                    isendto(nsndto) = jn 
    808                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     811                     isendto(nsndto) = jn 
     812                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    809813                   nsndto = nsndto + 1 
    810                    isendto(nsndto) = jn 
     814                     isendto(nsndto) = jn 
    811815                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    812816                   nsndto = nsndto + 1 
    813                    isendto(nsndto) = jn 
     817                     isendto(nsndto) = jn 
    814818                END IF 
    815              END IF 
    816819          END DO 
     820          nfsloop = 1 
     821          nfeloop = nlci 
     822          DO jn = 2,jpni-1 
     823           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     824              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     825                 nfsloop = nldi 
     826              ENDIF 
     827              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     828                 nfeloop = nlei 
     829              ENDIF 
     830           ENDIF 
     831        END DO 
     832 
    817833      ENDIF 
    818834      l_north_nogather = .TRUE. 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4491 r4792  
    302302      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    303303 
    304       IF( lrst_oce .AND. ln_diahsb )   CALL dia_hsb_rst( kstp, 'WRITE' ) 
    305304      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    306305      ! Control and restarts 
    … …  
    312311      ENDIF 
    313312      IF( kstp == nit000   )   THEN 
    314          CALL iom_close( numror )     ! close input  ocean restart file 
    315          CALL FLUSH    ( numond )     ! flush output namelist oce 
    316          CALL FLUSH    ( numoni )     ! flush output namelist ice     
     313                 CALL iom_close( numror )     ! close input  ocean restart file 
     314         IF(lwm) CALL FLUSH    ( numond )     ! flush output namelist oce 
     315         IF(lwm) CALL FLUSH    ( numoni )     ! flush output namelist ice     
    317316      ENDIF 
    318317      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r3770 r4792  
    267267      !!---------------------------------------------------------------------- 
    268268      ! 
    269       ! It is not necessary to compute anything bellow the following depth 
     269      ! It is not necessary to compute anything below the following depth 
    270270      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) ) 
    271271      ! 
    … …  
    273273      pjl = jpkm1 
    274274      DO jk = jpkm1, 1, -1 
    275          zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
    276          IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
     275         IF(SUM(tmask(:,:,jk)) > 0 ) THEN 
     276            zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) ) 
     277            IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr 
     278         ELSE 
     279            pjl = jk                                            ! or regional sea-bed depth  
     280         ENDIF 
    277281      END DO 
    278282      ! 
Note: See TracChangeset for help on using the changeset viewer.