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 5575 for branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90 – NEMO

Ignore:
Timestamp:
2015-07-09T12:44:22+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO/dev_r5107_hadgem3_cplfld branch to trunk revision 5518
(= branching point of NEMO 3.6_stable).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5107_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r5473 r5575  
    140140      !!---------------------------------------------------------------------- 
    141141      USE ldftra_oce, ONLY:   aht0 
     142      USE iom 
    142143      ! 
    143144      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
     
    150151      CHARACTER (len=15) ::   clexp 
    151152      INTEGER,     POINTER, DIMENSION(:,:)  :: icof 
    152       INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata 
     153      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file 
    153154      !!---------------------------------------------------------------------- 
    154155      !                                 
     
    232233         ! Read 2d integer array to specify western boundary increase in the 
    233234         ! ===================== equatorial strip (20N-20S) defined at t-points 
    234           
    235          ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 
    236          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca: unable to allocate idata array' ) 
    237235         ! 
    238          CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    239          READ(inum,9101) clexp, iim, ijm 
    240          READ(inum,'(/)') 
    241          ifreq = 40 
    242          il1 = 1 
    243          DO jn = 1, jpidta/ifreq+1 
    244             READ(inum,'(/)') 
    245             il2 = MIN( jpidta, il1+ifreq-1 ) 
    246             READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
    247             READ(inum,'(/)') 
    248             DO jj = jpjdta, 1, -1 
    249                READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    250             END DO 
    251             il1 = il1 + ifreq 
    252          END DO 
    253  
    254          DO jj = 1, nlcj 
    255             DO ji = 1, nlci 
    256                icof(ji,jj) = idata( mig(ji), mjg(jj) ) 
    257             END DO 
    258          END DO 
    259          DO jj = nlcj+1, jpj 
    260             DO ji = 1, nlci 
    261                icof(ji,jj) = icof(ji,nlcj) 
    262             END DO 
    263          END DO 
    264          DO jj = 1, jpj 
    265             DO ji = nlci+1, jpi 
    266                icof(ji,jj) = icof(nlci,jj) 
    267             END DO 
    268          END DO 
    269  
    270 9101     FORMAT(1x,a15,2i8) 
    271 9201     FORMAT(3x,13(i3,12x)) 
    272 9202     FORMAT(i3,41i3) 
    273           
    274          DEALLOCATE(idata) 
     236         ALLOCATE( ztemp2d(jpi,jpj) ) 
     237         ztemp2d(:,:) = 0. 
     238         CALL iom_open ( 'ahmcoef.nc', inum ) 
     239         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d) 
     240         icof(:,:)  = NINT(ztemp2d(:,:)) 
     241         CALL iom_close( inum ) 
     242         DEALLOCATE(ztemp2d) 
    275243 
    276244         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator) 
     
    369337      !!---------------------------------------------------------------------- 
    370338      USE ldftra_oce, ONLY:   aht0 
     339      USE iom 
    371340      ! 
    372341      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
     
    380349      CHARACTER (len=15) ::   clexp 
    381350      INTEGER,     POINTER, DIMENSION(:,:)  :: icof 
    382       INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: idata 
     351      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d  ! temporary array to read ahmcoef file 
    383352      !!---------------------------------------------------------------------- 
    384353      !                                 
    385354      CALL wrk_alloc( jpi   , jpj   , icof  ) 
    386355      !                                 
    387  
    388356      IF(lwp) WRITE(numout,*) 
    389357      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
     
    464432         ! Read 2d integer array to specify western boundary increase in the 
    465433         ! ===================== equatorial strip (20N-20S) defined at t-points 
    466           
    467          ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 
    468          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca_R1: unable to allocate idata array' ) 
    469          ! 
    470          CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
    471             &           1, numout, lwp ) 
    472          REWIND inum 
    473          READ(inum,9101) clexp, iim, ijm 
    474          READ(inum,'(/)') 
    475          ifreq = 40 
    476          il1 = 1 
    477          DO jn = 1, jpidta/ifreq+1 
    478             READ(inum,'(/)') 
    479             il2 = MIN( jpidta, il1+ifreq-1 ) 
    480             READ(inum,9201) ( ii, ji = il1, il2, 5 ) 
    481             READ(inum,'(/)') 
    482             DO jj = jpjdta, 1, -1 
    483                READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 
    484             END DO 
    485             il1 = il1 + ifreq 
    486          END DO 
    487  
    488          DO jj = 1, nlcj 
    489             DO ji = 1, nlci 
    490                icof(ji,jj) = idata( mig(ji), mjg(jj) ) 
    491             END DO 
    492          END DO 
    493          DO jj = nlcj+1, jpj 
    494             DO ji = 1, nlci 
    495                icof(ji,jj) = icof(ji,nlcj) 
    496             END DO 
    497          END DO 
    498          DO jj = 1, jpj 
    499             DO ji = nlci+1, jpi 
    500                icof(ji,jj) = icof(nlci,jj) 
    501             END DO 
    502          END DO 
    503  
    504 9101     FORMAT(1x,a15,2i8) 
    505 9201     FORMAT(3x,13(i3,12x)) 
    506 9202     FORMAT(i3,41i3) 
    507           
    508          DEALLOCATE(idata) 
     434         ALLOCATE( ztemp2d(jpi,jpj) ) 
     435         ztemp2d(:,:) = 0. 
     436         CALL iom_open ( 'ahmcoef.nc', inum ) 
     437         CALL iom_get  ( inum, jpdom_data, 'icof', ztemp2d) 
     438         icof(:,:)  = NINT(ztemp2d(:,:)) 
     439         CALL iom_close( inum ) 
     440         DEALLOCATE(ztemp2d) 
    509441 
    510442         ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator) 
Note: See TracChangeset for help on using the changeset viewer.