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 4957 for branches/2014 – NEMO

Changeset 4957 for branches/2014


Ignore:
Timestamp:
2014-12-02T15:21:47+01:00 (9 years ago)
Author:
acc
Message:

Branch dev_MERGE_2014. Style changes and implementation of ICB bugfix #1389.

Location:
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r4952 r4957  
    159159      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    160160902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
    161       IF(lwm)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       IF(lwm)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       IF(lwm)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       IF(lwm)WRITE( numond, namnc4 ) 
     329      IF(lwm) WRITE( numond, namnc4 ) 
    330330 
    331331      IF(lwp) THEN                        ! control print 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r4934 r4957  
    4444 
    4545INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes    
    46 !!INTEGER, PUBLIC & 
    47 !!#if !defined key_agrif  
    48 !!           , PARAMETER & 
    49 !!#endif 
    50 !!     :: & 
    51 !!     nclasses = 10   !: Number of icebergs classes 
    5246   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming 
    5347 
     
    9387   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 
    9488   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e 
    95    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e 
     89   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, hicth 
    9690   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9791   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
     
    180174         &      vi_e(0:jpi+1,0:jpj+1) ,                            & 
    181175#endif 
    182          &      ff_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
     176         &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   & 
     177         &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
     178         &      hicth(0:jpi+1,0:jpj+1),                            & 
    183179         &      first_width(nclasses) , first_length(nclasses) ,   & 
    184180         &      src_calving (jpi,jpj) ,                            & 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r4934 r4957  
    7272      uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1) 
    7373      vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
    74       ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff   (:,:) 
     74      ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff   (:,:)  
     75      tt_e(:,:) = 0._wp ;   tt_e(1:jpi, 1:jpj) = sst_m(:,:) 
     76      fr_e(:,:) = 0._wp ;   fr_e(1:jpi, 1:jpj) = fr_i (:,:) 
    7577      ua_e(:,:) = 0._wp ;   ua_e(1:jpi, 1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    7678      va_e(:,:) = 0._wp ;   va_e(1:jpi, 1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
     
    8183      CALL lbc_lnk_icb( ua_e, 'U', -1._wp, 1, 1 ) 
    8284      CALL lbc_lnk_icb( va_e, 'V', -1._wp, 1, 1 ) 
     85      CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 
     86      CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 
     87#if defined key_lim2 
     88      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)   
     89      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )   
     90#endif 
    8391 
    8492#if defined key_lim2 || defined key_lim3 
     
    133141      !!---------------------------------------------------------------------- 
    134142 
    135       pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )         ! scale factors 
     143      pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )     ! scale factors 
    136144      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    137145      ! 
    138146      puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U' )             ! ocean velocities 
    139147      pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V' ) 
    140       psst = icb_utl_bilin( sst_m, pi, pj, 'T' )              ! SST 
    141       pcn  = icb_utl_bilin( fr_i , pi, pj, 'T' )              ! ice concentration 
     148      psst = icb_utl_bilin_h( tt_e, pi, pj, 'T' )             ! SST 
     149      pcn  = icb_utl_bilin_h( fr_e , pi, pj, 'T' )            ! ice concentration 
    142150      pff  = icb_utl_bilin_h( ff_e , pi, pj, 'F' )            ! Coriolis parameter 
    143151      ! 
    144152      pua  = icb_utl_bilin_h( ua_e , pi, pj, 'U' )            ! 10m wind 
    145153      pva  = icb_utl_bilin_h( va_e , pi, pj, 'V' )            ! here (ua,va) are stress => rough conversion from stress to speed 
    146       zcd  = 1.22_wp * 1.5e-3_wp                                  ! air density * drag coefficient 
     154      zcd  = 1.22_wp * 1.5e-3_wp                              ! air density * drag coefficient 
    147155      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    148       pua  = pua * zmod                                           ! note: stress module=0 necessarly implies ua=va=0 
     156      pua  = pua * zmod                                       ! note: stress module=0 necessarly implies ua=va=0 
    149157      pva  = pva * zmod 
    150158 
     
    155163      phi = 0._wp                                             ! LIM-3 case (to do) 
    156164# else 
    157       phi = icb_utl_bilin(hicif, pi, pj, 'T' )                ! ice thickness 
     165      phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness 
    158166# endif 
    159167#else 
     
    217225      END SELECT 
    218226      ! 
    219       ! find position in this processor 
    220       ii = mi1( ii ) 
    221       ij = mj1( ij ) 
     227      ! find position in this processor. Prevent near edge problems (see #1389) 
     228 
     229      if (ii.lt.mig(1)) then 
     230        ii = 1 
     231      else if (ii.gt.mig(jpi)) then 
     232        ii = jpi 
     233      else 
     234        ii  = mi1( ii  ) 
     235      end if 
     236 
     237      if (ij.lt.mjg(1)) then 
     238        ij = 1 
     239      else if (ij.gt.mjg(jpj)) then 
     240        ij = jpj 
     241      else 
     242        ij  = mj1( ij  ) 
     243      end if 
     244 
     245      if (ij.eq.jpj) ij=ij-1 
     246      if (ii.eq.jpi) ii=ii-1       
     247 
    222248      ! 
    223249      icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
     
    271297      END SELECT 
    272298      ! 
    273       ! find position in this processor 
    274       ii = mi1( ii ) 
    275       ij = mj1( ij ) 
    276       ! 
     299      ! find position in this processor. Prevent near edge problems (see #1389) 
     300 
     301      if (ii.lt.mig(1)) then 
     302        ii = 1 
     303      else if (ii.gt.mig(jpi)) then 
     304        ii = jpi 
     305      else 
     306        ii  = mi1( ii  ) 
     307      end if 
     308 
     309      if (ij.lt.mjg(1)) then 
     310        ij = 1 
     311      else if (ij.gt.mjg(jpj)) then 
     312        ij = jpj 
     313      else 
     314        ij  = mj1( ij  ) 
     315      end if 
     316 
     317      if (ij.eq.jpj) ij=ij-1 
     318      if (ii.eq.jpi) ii=ii-1 
     319 
    277320      icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    278321         &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
     
    309352      zj = pj - REAL(ij,wp) 
    310353      ! 
    311       ! find position in this processor          !!gm use here mig, mjg arrays 
    312       ii = mi1( ii ) 
    313       ij = mj1( ij ) 
     354      ! find position in this processor. Prevent near edge problems (see #1389) 
     355 
     356      if (ii.lt.mig(1)) then 
     357        ii = 1 
     358      else if (ii.gt.mig(jpi)) then 
     359        ii = jpi 
     360      else 
     361        ii  = mi1( ii  ) 
     362      end if 
     363 
     364      if (ij.lt.mjg(1)) then 
     365        ij = 1 
     366      else if (ij.gt.mjg(jpj)) then 
     367        ij = jpj 
     368      else 
     369        ij  = mj1( ij  ) 
     370      end if 
     371 
     372      if (ij.eq.jpj) ij=ij-1 
     373      if (ii.eq.jpi) ii=ii-1 
     374 
    314375      z4(1) = pfld(ii  ,ij  ) 
    315376      z4(2) = pfld(ii+1,ij  ) 
     
    359420      zj = pj - REAL(ij,wp) 
    360421 
    361       ! find position in this processor 
    362       ii = mi1( ii ) 
    363       ij = mj1( ij ) 
     422      ! find position in this processor. Prevent near edge problems (see #1389) 
     423 
     424      if (ii.lt.mig(1)) then 
     425        ii = 1 
     426      else if (ii.gt.mig(jpi)) then 
     427        ii = jpi 
     428      else 
     429        ii  = mi1( ii  ) 
     430      end if 
     431 
     432      if (ij.lt.mjg(1)) then 
     433        ij = 1 
     434      else if (ij.gt.mjg(jpj)) then 
     435        ij = jpj 
     436      else 
     437        ij  = mj1( ij  ) 
     438      end if 
     439 
     440      if (ij.eq.jpj) ij=ij-1 
     441      if (ii.eq.jpi) ii=ii-1 
    364442 
    365443      IF(    0.0_wp <= zi .AND. zi < 0.5_wp   ) THEN 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4953 r4957  
    159159902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in configuration namelist', lwp ) 
    160160 
    161          IF(lwm)WRITE ( numond, namsbc_core ) 
     161         IF(lwm) WRITE( numond, namsbc_core ) 
    162162         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    163163         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r4946 r4957  
    5454   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2 
    5555   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 
    56 #ifdef key_agrif 
     56#if defined key_agrif 
    5757   ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals 
    5858   REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90

    r4952 r4957  
    5454      READ  ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 
    5555902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 
    56       IF(lwm)WRITE( numond, namtrd ) 
     56      IF(lwm) WRITE( numond, namtrd ) 
    5757      ! 
    5858      IF(lwp) THEN                  ! control print 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r4946 r4957  
    764764      READ  ( numnam_cfg, namtrd_mxl, IOSTAT = ios, ERR = 902 ) 
    765765902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd_mxl in configuration namelist', lwp ) 
    766       WRITE( numond, namtrd_mxl ) 
     766      IF(lwm) WRITE( numond, namtrd_mxl ) 
    767767      ! 
    768768      IF(lwp) THEN                      ! control print 
  • branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r4953 r4957  
    388388      READ  ( numnam_cfg, namzdf_tmx, IOSTAT = ios, ERR = 902 ) 
    389389902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tmx in configuration namelist', lwp ) 
    390       IF(lwm)WRITE ( numond, namzdf_tmx ) 
     390      IF(lwm) WRITE ( numond, namzdf_tmx ) 
    391391 
    392392      IF(lwp) THEN                   ! Control print 
Note: See TracChangeset for help on using the changeset viewer.