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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r3632 r5965  
    113113      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 
    114114      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115 #if defined key_diaar5 
    116       REAL(wp) ::   zztmp              ! local scalar 
    117 #endif 
    118115      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d 
    119116      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw  
    … …  
    207204      END DO 
    208205      ! 
    209 #if defined key_iomput 
    210       IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
    211          CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
    212          DO jk=1,jpkm1 
    213             zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
    214          END DO 
    215          zw3d(:,:,jpk) = 0._wp 
    216          CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
    217  
    218          DO jk=1,jpk-1 
    219             zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
    220          END DO 
    221          zw3d(:,:,jpk) = 0._wp 
    222          CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
    223  
    224          DO jk=1,jpk-1 
    225             DO jj = 2, jpjm1 
    226                DO ji = fs_2, fs_jpim1  ! vector opt. 
    227                   zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
    228                        &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
    229                END DO 
    230             END DO 
    231          END DO 
    232          zw3d(:,:,jpk) = 0._wp 
    233          CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
    234          CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     206      IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") )  THEN 
     207         ! 
     208         IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 
     209            CALL wrk_alloc( jpi , jpj , jpk  , zw3d ) 
     210            DO jk=1,jpkm1 
     211               zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz 
     212            END DO 
     213            zw3d(:,:,jpk) = 0._wp 
     214            CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current 
     215 
     216            DO jk=1,jpk-1 
     217               zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz 
     218            END DO 
     219            zw3d(:,:,jpk) = 0._wp 
     220            CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current 
     221 
     222            DO jk=1,jpk-1 
     223               DO jj = 2, jpjm1 
     224                  DO ji = fs_2, fs_jpim1  ! vector opt. 
     225                     zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 
     226                          &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 
     227                  END DO 
     228               END DO 
     229            END DO 
     230            zw3d(:,:,jpk) = 0._wp 
     231            CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current 
     232            CALL wrk_dealloc( jpi , jpj , jpk  , zw3d ) 
     233         ENDIF 
     234         ! 
    235235      ENDIF 
    236 #endif 
    237236      !                                                          ! =========== 
    238237      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    252251         END DO 
    253252         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level 
    254 # if defined key_vectopt_loop 
    255             DO jj = 1, 1 
    256                DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    257 # else 
    258253            DO jj = 1, jpjm1 
    259254               DO ji = 1, jpim1 
    260 # endif 
    261255                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    262256                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    … …  
    392386         ! 
    393387         !                             ! "Poleward" diffusive heat or salt transports (T-S case only) 
    394          IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 
    395             IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names 
    396             IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) ) 
     388         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 
     389            IF( jn == jp_tem)   htr_ldf(:) = ptr_sj( zftv(:,:,:) )        ! 3.3  names 
     390            IF( jn == jp_sal)   str_ldf(:) = ptr_sj( zftv(:,:,:) ) 
    397391         ENDIF 
    398392 
    399 #if defined key_diaar5 
    400          IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    401             z2d(:,:) = 0._wp 
    402             zztmp = rau0 * rcp 
    403             DO jk = 1, jpkm1 
    404                DO jj = 2, jpjm1 
    405                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    406                      z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
    407                   END DO 
    408                END DO 
    409             END DO 
    410             z2d(:,:) = zztmp * z2d(:,:) 
    411             CALL lbc_lnk( z2d, 'U', -1. ) 
    412             CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    413             z2d(:,:) = 0._wp 
    414             DO jk = 1, jpkm1 
    415                DO jj = 2, jpjm1 
    416                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    417                      z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
    418                   END DO 
    419                END DO 
    420             END DO 
    421             z2d(:,:) = zztmp * z2d(:,:) 
    422             CALL lbc_lnk( z2d, 'V', -1. ) 
    423             CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction 
    424          END IF 
    425 #endif 
     393         IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 
     394           ! 
     395           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
     396               z2d(:,:) = 0._wp  
     397               DO jk = 1, jpkm1 
     398                  DO jj = 2, jpjm1 
     399                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     400                        z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)  
     401                     END DO 
     402                  END DO 
     403               END DO 
     404               z2d(:,:) = rau0_rcp * z2d(:,:)  
     405               CALL lbc_lnk( z2d, 'U', -1. ) 
     406               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
     407               ! 
     408               z2d(:,:) = 0._wp  
     409               DO jk = 1, jpkm1 
     410                  DO jj = 2, jpjm1 
     411                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     412                        z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)  
     413                     END DO 
     414                  END DO 
     415               END DO 
     416               z2d(:,:) = rau0_rcp * z2d(:,:)      
     417               CALL lbc_lnk( z2d, 'V', -1. ) 
     418               CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
     419            END IF 
     420            ! 
     421         ENDIF 
    426422         ! 
    427423      END DO 
Note: See TracChangeset for help on using the changeset viewer.