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

Changeset 8708


Ignore:
Timestamp:
2017-11-15T12:39:36+01:00 (7 years ago)
Author:
andmirek
Message:

#1976 improvements in LIM3 restart. Working version

Location:
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r7813 r8708  
    8686            ENDIF 
    8787            ! 
    88             CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     88            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib, ndlev = jpl ) 
    8989            lrst_ice = .TRUE. 
    9090         ENDIF 
     
    107107      CHARACTER(len=25) ::   znam 
    108108      CHARACTER(len=2)  ::   zchar, zchar1 
    109       REAL(wp), POINTER, DIMENSION(:,:) :: z2d 
    110       !!---------------------------------------------------------------------- 
    111  
    112       CALL wrk_alloc( jpi, jpj, z2d ) 
     109      REAL(wp), POINTER, DIMENSION(:,:, :) :: z3d 
     110      !!---------------------------------------------------------------------- 
     111 
     112      CALL wrk_alloc( jpi, jpj, jpl,  z3d ) 
    113113 
    114114      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
     
    127127 
    128128      ! Prognostic variables  
    129       DO jl = 1, jpl  
    130          WRITE(zchar,'(I2.2)') jl 
    131          znam = 'v_i'//'_htc'//zchar 
    132          z2d(:,:) = v_i(:,:,jl) 
    133          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    134          znam = 'v_s'//'_htc'//zchar 
    135          z2d(:,:) = v_s(:,:,jl) 
    136          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    137          znam = 'smv_i'//'_htc'//zchar 
    138          z2d(:,:) = smv_i(:,:,jl) 
    139          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    140          znam = 'oa_i'//'_htc'//zchar 
    141          z2d(:,:) = oa_i(:,:,jl) 
    142          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    143          znam = 'a_i'//'_htc'//zchar 
    144          z2d(:,:) = a_i(:,:,jl) 
    145          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    146          znam = 't_su'//'_htc'//zchar 
    147          z2d(:,:) = t_su(:,:,jl) 
    148          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    149          znam = 'tempt_sl1'//'_htc'//zchar 
    150          z2d(:,:) = e_s(:,:,1,jl) 
    151          CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    152          DO jk = 1, nlay_i  
    153             WRITE(zchar1,'(I2.2)') jk 
    154             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    155             z2d(:,:) = e_i(:,:,jk,jl) 
    156             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    157          END DO 
     129      znam = 'v_i' 
     130      CALL iom_rstput( iter, nitrst, numriw, znam , v_i ) 
     131      znam = 'v_s' 
     132      CALL iom_rstput( iter, nitrst, numriw, znam , v_s ) 
     133      znam = 'smv_i' 
     134      CALL iom_rstput( iter, nitrst, numriw, znam , smv_i ) 
     135      znam = 'oa_i' 
     136      CALL iom_rstput( iter, nitrst, numriw, znam , oa_i ) 
     137      znam = 'a_i' 
     138      CALL iom_rstput( iter, nitrst, numriw, znam , a_i ) 
     139      znam = 't_su' 
     140      CALL iom_rstput( iter, nitrst, numriw, znam , t_su ) 
     141      znam = 'tempt_sl1' 
     142      z3d = e_s(:,:,1,:) 
     143      CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     144      DO jk = 1, nlay_i  
     145         WRITE(zchar1,'(I2.2)') jk 
     146         znam = 'tempt'//'_il'//zchar1 
     147         z3d(:,:,:) = e_i(:,:,jk,:) 
     148         CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
    158149      END DO 
    159150 
     
    169160      ! ------------------------------------------------------------------------ 
    170161      IF( nn_limadv == -1 ) THEN 
    171           
    172          DO jl = 1, jpl  
    173             WRITE(zchar,'(I2.2)') jl 
    174             znam = 'sxice'//'_htc'//zchar 
    175             z2d(:,:) = sxice(:,:,jl) 
    176             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    177             znam = 'syice'//'_htc'//zchar 
    178             z2d(:,:) = syice(:,:,jl) 
    179             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    180             znam = 'sxxice'//'_htc'//zchar 
    181             z2d(:,:) = sxxice(:,:,jl) 
    182             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    183             znam = 'syyice'//'_htc'//zchar 
    184             z2d(:,:) = syyice(:,:,jl) 
    185             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    186             znam = 'sxyice'//'_htc'//zchar 
    187             z2d(:,:) = sxyice(:,:,jl) 
    188             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    189             znam = 'sxsn'//'_htc'//zchar 
    190             z2d(:,:) = sxsn(:,:,jl) 
    191             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    192             znam = 'sysn'//'_htc'//zchar 
    193             z2d(:,:) = sysn(:,:,jl) 
    194             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    195             znam = 'sxxsn'//'_htc'//zchar 
    196             z2d(:,:) = sxxsn(:,:,jl) 
    197             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    198             znam = 'syysn'//'_htc'//zchar 
    199             z2d(:,:) = syysn(:,:,jl) 
    200             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    201             znam = 'sxysn'//'_htc'//zchar 
    202             z2d(:,:) = sxysn(:,:,jl) 
    203             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    204             znam = 'sxa'//'_htc'//zchar 
    205             z2d(:,:) = sxa(:,:,jl) 
    206             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    207             znam = 'sya'//'_htc'//zchar 
    208             z2d(:,:) = sya(:,:,jl) 
    209             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    210             znam = 'sxxa'//'_htc'//zchar 
    211             z2d(:,:) = sxxa(:,:,jl) 
    212             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    213             znam = 'syya'//'_htc'//zchar 
    214             z2d(:,:) = syya(:,:,jl) 
    215             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    216             znam = 'sxya'//'_htc'//zchar 
    217             z2d(:,:) = sxya(:,:,jl) 
    218             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    219             znam = 'sxc0'//'_htc'//zchar 
    220             z2d(:,:) = sxc0(:,:,jl) 
    221             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    222             znam = 'syc0'//'_htc'//zchar 
    223             z2d(:,:) = syc0(:,:,jl) 
    224             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    225             znam = 'sxxc0'//'_htc'//zchar 
    226             z2d(:,:) = sxxc0(:,:,jl) 
    227             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    228             znam = 'syyc0'//'_htc'//zchar 
    229             z2d(:,:) = syyc0(:,:,jl) 
    230             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    231             znam = 'sxyc0'//'_htc'//zchar 
    232             z2d(:,:) = sxyc0(:,:,jl) 
    233             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    234             znam = 'sxsal'//'_htc'//zchar 
    235             z2d(:,:) = sxsal(:,:,jl) 
    236             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    237             znam = 'sysal'//'_htc'//zchar 
    238             z2d(:,:) = sysal(:,:,jl) 
    239             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    240             znam = 'sxxsal'//'_htc'//zchar 
    241             z2d(:,:) = sxxsal(:,:,jl) 
    242             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    243             znam = 'syysal'//'_htc'//zchar 
    244             z2d(:,:) = syysal(:,:,jl) 
    245             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    246             znam = 'sxysal'//'_htc'//zchar 
    247             z2d(:,:) = sxysal(:,:,jl) 
    248             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    249             znam = 'sxage'//'_htc'//zchar 
    250             z2d(:,:) = sxage(:,:,jl) 
    251             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    252             znam = 'syage'//'_htc'//zchar 
    253             z2d(:,:) = syage(:,:,jl) 
    254             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    255             znam = 'sxxage'//'_htc'//zchar 
    256             z2d(:,:) = sxxage(:,:,jl) 
    257             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    258             znam = 'syyage'//'_htc'//zchar 
    259             z2d(:,:) = syyage(:,:,jl) 
    260             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    261             znam = 'sxyage'//'_htc'//zchar 
    262             z2d(:,:) = sxyage(:,:,jl) 
    263             CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    264          END DO 
     162         write(*,*) 'BACK in LIM3+1',nn_limadv  
     163         znam = 'sxice' 
     164         CALL iom_rstput( iter, nitrst, numriw, znam , sxice ) 
     165         znam = 'syice' 
     166         CALL iom_rstput( iter, nitrst, numriw, znam , syice ) 
     167         znam = 'sxxice' 
     168         CALL iom_rstput( iter, nitrst, numriw, znam , sxxice ) 
     169         znam = 'syyice' 
     170         CALL iom_rstput( iter, nitrst, numriw, znam , syyice ) 
     171         znam = 'sxyice' 
     172         CALL iom_rstput( iter, nitrst, numriw, znam , sxyice ) 
     173         znam = 'sxsn' 
     174         CALL iom_rstput( iter, nitrst, numriw, znam , sxsn ) 
     175         znam = 'sysn' 
     176         CALL iom_rstput( iter, nitrst, numriw, znam , sysn ) 
     177         znam = 'sxxsn' 
     178         CALL iom_rstput( iter, nitrst, numriw, znam , sxxsn ) 
     179         znam = 'syysn' 
     180         CALL iom_rstput( iter, nitrst, numriw, znam , syysn ) 
     181         znam = 'sxysn' 
     182         CALL iom_rstput( iter, nitrst, numriw, znam , sxysn ) 
     183         znam = 'sxa' 
     184         CALL iom_rstput( iter, nitrst, numriw, znam , sxa ) 
     185         znam = 'sya' 
     186         CALL iom_rstput( iter, nitrst, numriw, znam , sya ) 
     187         znam = 'sxxa' 
     188         CALL iom_rstput( iter, nitrst, numriw, znam , sxxa ) 
     189         znam = 'syya' 
     190         CALL iom_rstput( iter, nitrst, numriw, znam , syya ) 
     191         znam = 'sxya' 
     192         CALL iom_rstput( iter, nitrst, numriw, znam , sxya ) 
     193         znam = 'sxc0' 
     194         CALL iom_rstput( iter, nitrst, numriw, znam , sxc0 ) 
     195         znam = 'syc0' 
     196         CALL iom_rstput( iter, nitrst, numriw, znam , syc0 ) 
     197         znam = 'sxxc0' 
     198         CALL iom_rstput( iter, nitrst, numriw, znam , sxxc0 ) 
     199         znam = 'syyc0' 
     200         CALL iom_rstput( iter, nitrst, numriw, znam , syyc0 ) 
     201         znam = 'sxyc0' 
     202         CALL iom_rstput( iter, nitrst, numriw, znam , sxyc0 ) 
     203         znam = 'sxsal' 
     204         CALL iom_rstput( iter, nitrst, numriw, znam , sxsal ) 
     205         znam = 'sysal' 
     206         CALL iom_rstput( iter, nitrst, numriw, znam , sysal ) 
     207         znam = 'sxxsal' 
     208         CALL iom_rstput( iter, nitrst, numriw, znam , sxxsal ) 
     209         znam = 'syysal' 
     210         CALL iom_rstput( iter, nitrst, numriw, znam , syysal ) 
     211         znam = 'sxysal' 
     212         CALL iom_rstput( iter, nitrst, numriw, znam , sxysal ) 
     213         znam = 'sxage' 
     214         CALL iom_rstput( iter, nitrst, numriw, znam , sxage ) 
     215         znam = 'syage' 
     216         CALL iom_rstput( iter, nitrst, numriw, znam , syage ) 
     217         znam = 'sxxage' 
     218         CALL iom_rstput( iter, nitrst, numriw, znam , sxxage ) 
     219         znam = 'syyage' 
     220         CALL iom_rstput( iter, nitrst, numriw, znam , syyage ) 
     221         znam = 'sxyage' 
     222         CALL iom_rstput( iter, nitrst, numriw, znam , sxyage ) 
    265223 
    266224         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  ) 
     
    270228         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw ) 
    271229          
    272          DO jl = 1, jpl  
    273             WRITE(zchar,'(I2.2)') jl 
    274             DO jk = 1, nlay_i  
     230         DO jk = 1, nlay_i  
    275231               WRITE(zchar1,'(I2.2)') jk 
    276                znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    277                z2d(:,:) = sxe(:,:,jk,jl) 
    278                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    279                znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    280                z2d(:,:) = sye(:,:,jk,jl) 
    281                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    282                znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    283                z2d(:,:) = sxxe(:,:,jk,jl) 
    284                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    285                znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    286                z2d(:,:) = syye(:,:,jk,jl) 
    287                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    288                znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    289                z2d(:,:) = sxye(:,:,jk,jl) 
    290                CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    291             END DO 
     232               znam = 'sxe'//'_il'//zchar1 
     233               z3d(:,:,:) = sxe(:,:,jk,:) 
     234               CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     235               znam = 'sye'//'_il'//zchar1 
     236               z3d(:,:,:) = sye(:,:,jk,:) 
     237               CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     238               znam = 'sxxe'//'_il'//zchar1 
     239               z3d(:,:,:) = sxxe(:,:,jk,:) 
     240               CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     241               znam = 'syye'//'_il'//zchar1 
     242               z3d(:,:,:) = syye(:,:,jk,:) 
     243               CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
     244               znam = 'sxye'//'_il'//zchar1 
     245               z3d(:,:,:) = sxye(:,:,jk,:) 
     246               CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
    292247         END DO 
    293248 
     
    301256      ENDIF 
    302257      ! 
    303       CALL wrk_dealloc( jpi, jpj, z2d ) 
     258      CALL wrk_dealloc( jpi, jpj, jpl, z3d ) 
    304259      ! 
    305260   END SUBROUTINE lim_rst_write 
     
    314269      INTEGER :: ji, jj, jk, jl 
    315270      REAL(wp) ::   zfice, ziter 
    316       REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
     271      REAL(wp), POINTER, DIMENSION(:,:, :) ::   z3d 
    317272      CHARACTER(len=25) ::   znam 
    318273      CHARACTER(len=2)  ::   zchar, zchar1 
     
    321276      !!---------------------------------------------------------------------- 
    322277 
    323       CALL wrk_alloc( jpi, jpj, z2d ) 
     278      CALL wrk_alloc( jpi, jpj, jpl, z3d ) 
    324279 
    325280      IF(lwp) THEN 
     
    329284      ENDIF 
    330285 
    331       CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
     286      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib, ndlev = jpl ) 
    332287 
    333288      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     
    348303 
    349304      ! Prognostic variables  
    350       DO jl = 1, jpl  
    351          WRITE(zchar,'(I2.2)') jl 
    352          znam = 'v_i'//'_htc'//zchar 
    353          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    354          v_i(:,:,jl) = z2d(:,:) 
    355          znam = 'v_s'//'_htc'//zchar 
    356          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    357          v_s(:,:,jl) = z2d(:,:)  
    358          znam = 'smv_i'//'_htc'//zchar 
    359          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    360          smv_i(:,:,jl) = z2d(:,:) 
    361          znam = 'oa_i'//'_htc'//zchar 
    362          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    363          oa_i(:,:,jl) = z2d(:,:) 
    364          znam = 'a_i'//'_htc'//zchar 
    365          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    366          a_i(:,:,jl) = z2d(:,:) 
    367          znam = 't_su'//'_htc'//zchar 
    368          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    369          t_su(:,:,jl) = z2d(:,:) 
    370          znam = 'tempt_sl1'//'_htc'//zchar 
    371          CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    372          e_s(:,:,1,jl) = z2d(:,:) 
    373          DO jk = 1, nlay_i  
    374             WRITE(zchar1,'(I2.2)') jk 
    375             znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    376             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    377             e_i(:,:,jk,jl) = z2d(:,:) 
    378          END DO 
     305      znam = 'v_i' 
     306      CALL iom_get( numrir, jpdom_autoglo, znam , v_i ) 
     307      znam = 'v_s' 
     308      CALL iom_get( numrir, jpdom_autoglo, znam , v_s ) 
     309      znam = 'smv_i' 
     310      CALL iom_get( numrir, jpdom_autoglo, znam , smv_i ) 
     311      znam = 'oa_i' 
     312      CALL iom_get( numrir, jpdom_autoglo, znam , oa_i ) 
     313      znam = 'a_i' 
     314      CALL iom_get( numrir, jpdom_autoglo, znam , a_i ) 
     315      znam = 't_su' 
     316      CALL iom_get( numrir, jpdom_autoglo, znam , t_su ) 
     317      znam = 'tempt_sl1' 
     318      CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     319      e_s(:,:,1,:) = z3d 
     320      DO jk = 1, nlay_i  
     321         WRITE(zchar1,'(I2.2)') jk 
     322         znam = 'tempt'//'_il'//zchar1 
     323         CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     324         e_i(:,:,jk,:) = z3d(:,:,:) 
    379325      END DO 
    380326 
     
    391337      IF( nn_limadv == -1 ) THEN 
    392338 
    393          DO jl = 1, jpl  
    394             WRITE(zchar,'(I2.2)') jl 
    395             znam = 'sxice'//'_htc'//zchar 
    396             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    397             sxice(:,:,jl) = z2d(:,:) 
    398             znam = 'syice'//'_htc'//zchar 
    399             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    400             syice(:,:,jl) = z2d(:,:) 
    401             znam = 'sxxice'//'_htc'//zchar 
    402             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    403             sxxice(:,:,jl) = z2d(:,:) 
    404             znam = 'syyice'//'_htc'//zchar 
    405             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    406             syyice(:,:,jl) = z2d(:,:) 
    407             znam = 'sxyice'//'_htc'//zchar 
    408             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    409             sxyice(:,:,jl) = z2d(:,:) 
    410             znam = 'sxsn'//'_htc'//zchar 
    411             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    412             sxsn(:,:,jl) = z2d(:,:) 
    413             znam = 'sysn'//'_htc'//zchar 
    414             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    415             sysn(:,:,jl) = z2d(:,:) 
    416             znam = 'sxxsn'//'_htc'//zchar 
    417             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    418             sxxsn(:,:,jl) = z2d(:,:) 
    419             znam = 'syysn'//'_htc'//zchar 
    420             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    421             syysn(:,:,jl) = z2d(:,:) 
    422             znam = 'sxysn'//'_htc'//zchar 
    423             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    424             sxysn(:,:,jl) = z2d(:,:) 
    425             znam = 'sxa'//'_htc'//zchar 
    426             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    427             sxa(:,:,jl) = z2d(:,:) 
    428             znam = 'sya'//'_htc'//zchar 
    429             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    430             sya(:,:,jl) = z2d(:,:) 
    431             znam = 'sxxa'//'_htc'//zchar 
    432             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    433             sxxa(:,:,jl) = z2d(:,:) 
    434             znam = 'syya'//'_htc'//zchar 
    435             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    436             syya(:,:,jl) = z2d(:,:) 
    437             znam = 'sxya'//'_htc'//zchar 
    438             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    439             sxya(:,:,jl) = z2d(:,:) 
    440             znam = 'sxc0'//'_htc'//zchar 
    441             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    442             sxc0(:,:,jl) = z2d(:,:) 
    443             znam = 'syc0'//'_htc'//zchar 
    444             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    445             syc0(:,:,jl) = z2d(:,:) 
    446             znam = 'sxxc0'//'_htc'//zchar 
    447             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    448             sxxc0(:,:,jl) = z2d(:,:) 
    449             znam = 'syyc0'//'_htc'//zchar 
    450             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    451             syyc0(:,:,jl) = z2d(:,:) 
    452             znam = 'sxyc0'//'_htc'//zchar 
    453             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    454             sxyc0(:,:,jl) = z2d(:,:) 
    455             znam = 'sxsal'//'_htc'//zchar 
    456             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    457             sxsal(:,:,jl) = z2d(:,:) 
    458             znam = 'sysal'//'_htc'//zchar 
    459             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    460             sysal(:,:,jl) = z2d(:,:) 
    461             znam = 'sxxsal'//'_htc'//zchar 
    462             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    463             sxxsal(:,:,jl) = z2d(:,:) 
    464             znam = 'syysal'//'_htc'//zchar 
    465             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    466             syysal(:,:,jl) = z2d(:,:) 
    467             znam = 'sxysal'//'_htc'//zchar 
    468             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    469             sxysal(:,:,jl) = z2d(:,:) 
    470             znam = 'sxage'//'_htc'//zchar 
    471             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    472             sxage(:,:,jl) = z2d(:,:) 
    473             znam = 'syage'//'_htc'//zchar 
    474             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    475             syage(:,:,jl) = z2d(:,:) 
    476             znam = 'sxxage'//'_htc'//zchar 
    477             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    478             sxxage(:,:,jl) = z2d(:,:) 
    479             znam = 'syyage'//'_htc'//zchar 
    480             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    481             syyage(:,:,jl) = z2d(:,:) 
    482             znam = 'sxyage'//'_htc'//zchar 
    483             CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    484             sxyage(:,:,jl)= z2d(:,:) 
    485          END DO 
     339         znam = 'sxice' 
     340         CALL iom_get( numrir, jpdom_autoglo, znam , sxice ) 
     341         znam = 'syice' 
     342         CALL iom_get( numrir, jpdom_autoglo, znam , syice ) 
     343         znam = 'sxxice' 
     344         CALL iom_get( numrir, jpdom_autoglo, znam , sxxice ) 
     345         znam = 'syyice' 
     346         CALL iom_get( numrir, jpdom_autoglo, znam , syyice ) 
     347         znam = 'sxyice' 
     348         CALL iom_get( numrir, jpdom_autoglo, znam , sxyice ) 
     349         znam = 'sxsn' 
     350         CALL iom_get( numrir, jpdom_autoglo, znam , sxsn ) 
     351         znam = 'sysn' 
     352         CALL iom_get( numrir, jpdom_autoglo, znam , sysn ) 
     353         znam = 'sxxsn' 
     354         CALL iom_get( numrir, jpdom_autoglo, znam , sxxsn ) 
     355         znam = 'syysn' 
     356         CALL iom_get( numrir, jpdom_autoglo, znam , syysn ) 
     357         znam = 'sxysn' 
     358         CALL iom_get( numrir, jpdom_autoglo, znam , sxysn ) 
     359         znam = 'sxa' 
     360         CALL iom_get( numrir, jpdom_autoglo, znam , sxa ) 
     361         znam = 'sya' 
     362         CALL iom_get( numrir, jpdom_autoglo, znam , sya ) 
     363         znam = 'sxxa' 
     364         CALL iom_get( numrir, jpdom_autoglo, znam , sxxa ) 
     365         znam = 'syya' 
     366         CALL iom_get( numrir, jpdom_autoglo, znam , syya ) 
     367         znam = 'sxya' 
     368         CALL iom_get( numrir, jpdom_autoglo, znam , sxya ) 
     369         znam = 'sxc0' 
     370         CALL iom_get( numrir, jpdom_autoglo, znam , sxc0 ) 
     371         znam = 'syc0' 
     372         CALL iom_get( numrir, jpdom_autoglo, znam , syc0 ) 
     373         znam = 'sxxc0' 
     374         CALL iom_get( numrir, jpdom_autoglo, znam , sxxc0 ) 
     375         znam = 'syyc0' 
     376         CALL iom_get( numrir, jpdom_autoglo, znam , syyc0 ) 
     377         znam = 'sxyc0' 
     378         CALL iom_get( numrir, jpdom_autoglo, znam , sxyc0 ) 
     379         znam = 'sxsal' 
     380         CALL iom_get( numrir, jpdom_autoglo, znam , sxsal ) 
     381         znam = 'sysal' 
     382         CALL iom_get( numrir, jpdom_autoglo, znam , sysal ) 
     383         znam = 'sxxsal' 
     384         CALL iom_get( numrir, jpdom_autoglo, znam , sxxsal ) 
     385         znam = 'syysal' 
     386         CALL iom_get( numrir, jpdom_autoglo, znam , syysal ) 
     387         znam = 'sxysal' 
     388         CALL iom_get( numrir, jpdom_autoglo, znam , sxysal ) 
     389         znam = 'sxage' 
     390         CALL iom_get( numrir, jpdom_autoglo, znam , sxage ) 
     391         znam = 'syage' 
     392         CALL iom_get( numrir, jpdom_autoglo, znam , syage ) 
     393         znam = 'sxxage' 
     394         CALL iom_get( numrir, jpdom_autoglo, znam , sxxage ) 
     395         znam = 'syyage' 
     396         CALL iom_get( numrir, jpdom_autoglo, znam , syyage ) 
     397         znam = 'sxyage' 
     398         CALL iom_get( numrir, jpdom_autoglo, znam , sxyage ) 
    486399 
    487400         CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  ) 
     
    495408            DO jk = 1, nlay_i  
    496409               WRITE(zchar1,'(I2.2)') jk 
    497                znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    498                CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    499                sxe(:,:,jk,jl) = z2d(:,:) 
    500                znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    501                CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    502                sye(:,:,jk,jl) = z2d(:,:) 
    503                znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    504                CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    505                sxxe(:,:,jk,jl) = z2d(:,:) 
    506                znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    507                CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    508                syye(:,:,jk,jl) = z2d(:,:) 
    509                znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    510                CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    511                sxye(:,:,jk,jl) = z2d(:,:) 
     410               znam = 'sxe'//'_il'//zchar1 
     411               CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     412               sxe(:,:,jk,:) = z3d(:,:,:) 
     413               znam = 'sye'//'_il'//zchar1 
     414               CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     415               sye(:,:,jk,:) = z3d(:,:,:) 
     416               znam = 'sxxe'//'_il'//zchar1 
     417               CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     418               sxxe(:,:,jk,:) = z3d(:,:,:) 
     419               znam = 'syye'//'_il'//zchar1 
     420               CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     421               syye(:,:,jk,:) = z3d(:,:,:) 
     422               znam = 'sxye'//'_il'//zchar1 
     423               CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     424               sxye(:,:,jk,:) = z3d(:,:,:) 
    512425            END DO 
    513426         END DO 
     
    528441      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    529442      ! 
    530       CALL wrk_dealloc( jpi, jpj, z2d ) 
     443      CALL wrk_dealloc( jpi, jpj, jpl, z3d ) 
    531444      ! 
    532445   END SUBROUTINE lim_rst_read 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8573 r8708  
    239239 
    240240 
    241    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof ) 
     241   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, ndlev ) 
    242242      !!--------------------------------------------------------------------- 
    243243      !!                   ***  SUBROUTINE  iom_open  *** 
     
    252252      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    253253      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
     254      INTEGER         , INTENT(in   ), OPTIONAL ::   ndlev     ! number of vertical levels 
    254255 
    255256      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     
    405406      IF( istop == nstop ) THEN   ! no error within this routine 
    406407         SELECT CASE (iolib) 
    407          CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar ) 
     408         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar, ndlev = ndlev ) 
    408409         CASE DEFAULT 
    409410            CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 
     
    672673      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    673674      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
     675      INTEGER                        ::   inlev        ! number of levels for 3D data 
    674676      !--------------------------------------------------------------------- 
    675677      ! 
     678      inlev = -1 
     679      IF(PRESENT(pv_r3d)) inlev = SIZE(pv_r3d, 3) 
    676680      clname = iom_file(kiomid)%name   !   esier to read 
    677681      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
     
    801805                  ENDIF 
    802806                  IF( PRESENT(pv_r3d) ) THEN 
    803                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo 
     807                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = inlev 
    804808                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    805                      ELSE                                                           ; icnt(3) = jpk 
     809                     ELSE                                                           ; icnt(3) = inlev 
    806810                     ENDIF 
    807811                  ENDIF 
     
    886890            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    887891               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    888                IF( icnt(3) == jpk ) THEN 
     892               IF( icnt(3) == inlev ) THEN 
    889893                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    890894               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r7646 r8708  
    6464      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6565      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
     66      INTEGER                                   ::   nlev     ! number of vertical levels 
    6667   END TYPE file_descriptor 
    6768   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r7646 r8708  
    5353CONTAINS 
    5454 
    55    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar ) 
     55   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, ndlev ) 
    5656      !!--------------------------------------------------------------------- 
    5757      !!                   ***  SUBROUTINE  iom_open  *** 
     
    6464      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    6565      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
     66      INTEGER                , INTENT(in   ), OPTIONAL ::   ndlev 
    6667 
    6768      CHARACTER(LEN=256) ::   clinfo           ! info character 
     
    7677      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7778      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
     79      INTEGER            ::   ilevels           ! vertical levels 
    7880      !--------------------------------------------------------------------- 
    7981 
    8082      clinfo = '                    iom_nf90_open ~~~  ' 
    8183      istop = nstop   ! store the actual value of nstop 
     84      ilevels = jpk 
     85      IF(PRESENT(ndlev)) ilevels = ndlev      ! number of vertical levels 
     86                                             ! by default jpk, but can be 
     87                                             ! different for LIM3 
    8288      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz 
    8389      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT 
     
    126132            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo) 
    127133            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo) 
     134            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', ilevels       , idmy ), clinfo) 
    129135            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 
    130136            ! global attributes 
     
    156162         iom_file(kiomid)%nvars  = 0 
    157163         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
     164         iom_file(kiomid)%nlev   = ilevels 
    158165         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    159166         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
     
    693700      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression 
    694701                                                    ! when appropriate (currently chunking is applied to 4d fields only) 
     702      INTEGER               :: i                    ! local variable 
    695703      !--------------------------------------------------------------------- 
    696704      ! 
     
    706714         ENDIF 
    707715         ! define the dimension variables if it is not already done 
    708          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /) 
     716         IF(iom_file(kiomid)%nlev == jpk ) THEN 
     717          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /) 
     718         ELSE 
     719          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'numcat     ', 'time_counter' /) 
     720         ENDIF 
    709721         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    710722         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
     
    819831               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo) 
    820832               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo) 
    821                CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo) 
    822                CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo) 
     833               IF(iom_file(kiomid)%nlev == jpk ) THEN  
     834                  !NEMO 
     835                  CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo) 
     836                  CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d                ), clinfo) 
     837               ELSE 
     838                  CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'numcat'     , idmy ), clinfo) 
     839                  CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, (/ (i, i = 1,iom_file(kiomid)%nlev) /)), clinfo) 
     840               ENDIF 
    823841               ! +++ WRONG VALUE: to be improved but not really useful... 
    824842               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo) 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r8114 r8708  
    135135      !!---------------------------------------------------------------------- 
    136136      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
     137      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    138138      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    139139      !!---------------------------------------------------------------------- 
     
    154154      !!---------------------------------------------------------------------- 
    155155      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    156       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     156      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    157157      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    158158      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    159159      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    160160      ! 
    161       INTEGER  ::   jk     ! dummy loop index 
    162       REAL(wp) ::   ztab   ! local scalar 
    163       !!---------------------------------------------------------------------- 
    164       ! 
    165       DO jk = 1, jpk 
     161      INTEGER  ::   jk, ilev     ! dummy loop index 
     162      REAL(wp) ::   ztab         ! local scalar 
     163      !!---------------------------------------------------------------------- 
     164      ! 
     165      ilev = SIZE(pt3d, 3) 
     166      DO jk = 1, ilev 
    166167         ztab = pt3d(2,2,jk) 
    167168         pt3d(:,:,jk) = ztab 
     
    268269      !!---------------------------------------------------------------------- 
    269270      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    270       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
     271      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    271272      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    272273      !!---------------------------------------------------------------------- 
     
    291292      !!---------------------------------------------------------------------- 
    292293      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    293       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     294      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    294295      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    295296      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     
    567568      !!---------------------------------------------------------------------- 
    568569      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    569       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     570      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    570571      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    571572      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     
    623624      !!---------------------------------------------------------------------- 
    624625      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    625       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
     626      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
    626627      REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign  
    627628      INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r7646 r8708  
    6262      ! 
    6363      INTEGER  ::   ji, jk 
    64       INTEGER  ::   ijt, iju, ijpj, ijpjm1 
     64      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ilev 
    6565      !!---------------------------------------------------------------------- 
    6666 
     
    7171      ijpjm1 = ijpj-1 
    7272 
    73       DO jk = 1, jpk 
     73      ilev = SIZE(pt3d, 3) 
     74      DO jk = 1, ilev 
    7475         ! 
    7576         SELECT CASE ( npolj ) 
     
    393394      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied 
    394395      ! 
    395       INTEGER  ::   ji, jk 
     396      INTEGER  ::   ji, jk, ilev 
    396397      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
    397398      !!---------------------------------------------------------------------- 
     
    402403      END SELECT 
    403404      ijpjm1 = ijpj-1 
    404  
     405      ilev = SIZE(pt3dl,3) 
    405406         ! 
    406407         SELECT CASE ( npolj ) 
     
    416417               ENDIF 
    417418 
    418                DO jk = 1, jpk 
     419               DO jk = 1, ilev 
    419420                  DO ji = startloop, nlci 
    420421                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     
    434435               ENDIF 
    435436               IF(startloop .le. nlci) THEN 
    436                  DO jk = 1, jpk 
     437                 DO jk = 1, ilev 
    437438                    DO ji = startloop, nlci 
    438439                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     
    455456                  endloop = nlci - 1 
    456457               ENDIF 
    457                DO jk = 1, jpk 
     458               DO jk = 1, ilev 
    458459                  DO ji = 1, endloop 
    459460                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    481482               ENDIF 
    482483               IF (startloop .le. endloop) THEN 
    483                  DO jk = 1, jpk 
     484                 DO jk = 1, ilev 
    484485                    DO ji = startloop, endloop 
    485486                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    501502                  startloop = 2 
    502503               ENDIF 
    503                DO jk = 1, jpk 
     504               DO jk = 1, ilev 
    504505                  DO ji = startloop, nlci 
    505506                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     
    517518                  endloop = nlci - 1 
    518519               ENDIF 
    519                DO jk = 1, jpk 
     520               DO jk = 1, ilev 
    520521                  DO ji = 1, endloop 
    521522                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    537538            SELECT CASE ( cd_type ) 
    538539            CASE ( 'T' , 'W' )                         ! T-, W-point 
    539                DO jk = 1, jpk 
     540               DO jk = 1, ilev 
    540541                  DO ji = 1, nlci 
    541542                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    550551                  endloop = nlci - 1 
    551552               ENDIF 
    552                DO jk = 1, jpk 
     553               DO jk = 1, ilev 
    553554                  DO ji = 1, endloop 
    554555                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     
    561562 
    562563            CASE ( 'V' )                               ! V-point 
    563                DO jk = 1, jpk 
     564               DO jk = 1, ilev 
    564565                  DO ji = 1, nlci 
    565566                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    576577               ENDIF 
    577578               IF(startloop .le. nlci) THEN 
    578                  DO jk = 1, jpk 
     579                 DO jk = 1, ilev 
    579580                    DO ji = startloop, nlci 
    580581                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     
    590591                  endloop = nlci - 1 
    591592               ENDIF 
    592                DO jk = 1, jpk 
     593               DO jk = 1, ilev 
    593594                  DO ji = 1, endloop 
    594595                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     
    613614               ENDIF 
    614615               IF (startloop .le. endloop) THEN 
    615                   DO jk = 1, jpk 
     616                  DO jk = 1, ilev 
    616617                     DO ji = startloop, endloop 
    617618                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     
    627628            SELECT CASE ( cd_type) 
    628629            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    629                pt3dl(:, 1  ,jk) = 0.e0 
    630                pt3dl(:,ijpj,jk) = 0.e0 
     630               pt3dl(:, 1  ,:) = 0.e0 
     631               pt3dl(:,ijpj,:) = 0.e0 
    631632            CASE ( 'F' )                               ! F-point 
    632                pt3dl(:,ijpj,jk) = 0.e0 
     633               pt3dl(:,ijpj,:) = 0.e0 
    633634            END SELECT 
    634635            ! 
  • branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7753 r8708  
    351351      !! 
    352352      !!---------------------------------------------------------------------- 
    353       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     353      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    354354      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    355355      !                                                             ! = T , U , V , F , W points 
     
    359359      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    360360      ! 
    361       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     361      INTEGER  ::   ji, jj, jk, jl, ilev       ! dummy loop indices 
    362362      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    363363      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     
    367367      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    368368      !!---------------------------------------------------------------------- 
    369        
    370       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    371          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
     369      ilev = SIZE(ptab, 3)  
     370      ALLOCATE( zt3ns(jpi,jprecj,ilev,2), zt3sn(jpi,jprecj,ilev,2),   & 
     371         &      zt3ew(jpj,jpreci,ilev,2), zt3we(jpj,jpreci,ilev,2)  ) 
    372372 
    373373      ! 
     
    381381         ! 
    382382         ! WARNING ptab is defined only between nld and nle 
    383          DO jk = 1, jpk 
     383         DO jk = 1, ilev 
    384384            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    385385               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
     
    430430      ! 
    431431      !                           ! Migrations 
    432       imigr = jpreci * jpj * jpk 
     432      imigr = jpreci * jpj * ilev 
    433433      ! 
    434434      SELECT CASE ( nbondi ) 
     
    482482      ! 
    483483      !                           ! Migrations 
    484       imigr = jprecj * jpi * jpk 
     484      imigr = jprecj * jpi * ilev 
    485485      ! 
    486486      SELECT CASE ( nbondj ) 
     
    10551055      !! 
    10561056      !!---------------------------------------------------------------------- 
    1057       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
    1058       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied 
     1057      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   ptab1     ! first and second 3D array on which 
     1058      REAL(wp), DIMENSION(:,:,:)      , INTENT(inout) ::   ptab2     ! the boundary condition is applied 
    10591059      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
    10601060      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points 
    10611061      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary 
    10621062      !!                                                             ! =  1. , the sign is kept 
    1063       INTEGER  ::   jl   ! dummy loop indices 
     1063      INTEGER  ::   jl, ilev                   ! dummy loop indices 
    10641064      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    10651065      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     
    10691069      !!---------------------------------------------------------------------- 
    10701070      ! 
    1071       ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    & 
    1072          &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 
     1071      ilev = SIZE(ptab1, 3) 
     1072      ALLOCATE( zt4ns(jpi,jprecj,ilev,2,2), zt4sn(jpi,jprecj,ilev,2,2) ,    & 
     1073         &      zt4ew(jpj,jpreci,ilev,2,2), zt4we(jpj,jpreci,ilev,2,2) ) 
    10731074      ! 
    10741075      ! 1. standard boundary treatment 
     
    11171118      ! 
    11181119      !                           ! Migrations 
    1119       imigr = jpreci * jpj * jpk *2 
     1120      imigr = jpreci * jpj * ilev *2 
    11201121      ! 
    11211122      SELECT CASE ( nbondi ) 
     
    11761177      ! 
    11771178      !                           ! Migrations 
    1178       imigr = jprecj * jpi * jpk * 2 
     1179      imigr = jprecj * jpi * ilev * 2 
    11791180      ! 
    11801181      SELECT CASE ( nbondj ) 
     
    14511452      !! 
    14521453      !!---------------------------------------------------------------------- 
    1453       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
     1454      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    14541455      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    14551456      !                                                             ! = T , U , V , F , W points 
     
    14591460      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    14601461      !! 
    1461       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
     1462      INTEGER  ::   ji, jj, jk, jl,ilev        ! dummy loop indices 
    14621463      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    14631464      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     
    14691470 
    14701471      !!---------------------------------------------------------------------- 
    1471        
    1472       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    1473          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
     1472      ilev = SIZE(ptab, 3)  
     1473      ALLOCATE( zt3ns(jpi,jprecj,ilev,2), zt3sn(jpi,jprecj,ilev,2),   & 
     1474         &      zt3ew(jpj,jpreci,ilev,2), zt3we(jpj,jpreci,ilev,2)  ) 
    14741475 
    14751476      ! 
     
    14941495      ! 
    14951496      !                           ! Migrations 
    1496       imigr = jpreci * jpj * jpk 
     1497      imigr = jpreci * jpj * ilev 
    14971498      ! 
    14981499      SELECT CASE ( nbondi ) 
     
    15471548      ! 
    15481549      !                           ! Migrations 
    1549       imigr = jprecj * jpi * jpk 
     1550      imigr = jprecj * jpi * ilev 
    15501551      ! 
    15511552      SELECT CASE ( nbondj ) 
Note: See TracChangeset for help on using the changeset viewer.