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 97 for trunk/NEMO/OPA_SRC – NEMO

Changeset 97 for trunk/NEMO/OPA_SRC


Ignore:
Timestamp:
2004-06-25T10:20:25+02:00 (20 years ago)
Author:
opalod
Message:

CT : BUGFIX063 : correction of ji loop indices while not using key_vectopt_loop cpp key

Location:
trunk/NEMO/OPA_SRC/TRA
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r67 r97  
    7979      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, zstep, zta, zsa 
    8080      REAL(wp) ::   z0u, z0v, z0w 
    81       REAL(wp) ::   z1u, z1v, z1w 
    8281      REAL(wp) ::   zzt1, zzt2, zalpha 
    8382      REAL(wp) ::   zzs1, zzs2 
     
    138137      DO jk = 1, jpkm1 
    139138         DO jj = 2, jpj 
    140             DO ji = fs_2, fs_jpim1   ! vector opt. 
    141                z0u = zt1(ji,jj,jk) * zt1(ji-1,jj,jk) 
    142                IF( z0u > 0. ) THEN 
    143                   ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk)+zt1(ji-1,jj,jk) ) 
    144                ELSE 
    145                   ztp1(ji,jj,jk) = 0.e0 
    146                ENDIF 
    147                z1u = zs1(ji,jj,jk) * zs1(ji-1,jj,jk) 
    148                IF( z1u > 0. ) THEN 
    149                   zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk)+zs1(ji-1,jj,jk) ) 
    150                ELSE 
    151                   zsp1(ji,jj,jk) = 0.e0 
    152                ENDIF 
    153  
    154                z0v = zt2(ji,jj,jk) * zt2(ji,jj-1,jk) 
    155                IF( z0v > 0. ) THEN 
    156                   ztp2(ji,jj,jk) = 0.5 * ( zt2(ji,jj,jk)+zt2(ji,jj-1,jk) ) 
    157                ELSE 
    158                   ztp2(ji,jj,jk) = 0.e0 
    159                ENDIF 
    160                z1v = zs2(ji,jj,jk) * zs2(ji,jj-1,jk) 
    161                IF( z1v > 0. ) THEN 
    162                   zsp2(ji,jj,jk) = 0.5 * ( zs2(ji,jj,jk)+zs2(ji,jj-1,jk) ) 
    163                ELSE 
    164                   zsp2(ji,jj,jk) = 0.e0 
    165                ENDIF 
     139            DO ji = fs_2, jpi   ! vector opt. 
     140               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   & 
     141                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) ) 
     142               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   & 
     143                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) ) 
     144               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   & 
     145                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) ) 
     146               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   & 
     147                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) ) 
    166148            END DO 
    167149         END DO 
     
    171153      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0 
    172154 
    173 ! Slopes limitation 
     155      ! Slopes limitation 
    174156      DO jk = 1, jpkm1 
    175157         DO jj = 2, jpj 
    176             DO ji = fs_2, fs_jpim1   ! vector opt. 
     158            DO ji = fs_2, jpi   ! vector opt. 
    177159               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    178160                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   & 
     
    285267      END DO         
    286268 
     269      IF(l_ctl) THEN 
     270         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     271         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     272         WRITE(numout,*) ' had  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' muscl' 
     273         t_ctl = zta   ;   s_ctl = zsa 
     274      ENDIF 
     275 
    287276#if defined key_diaptr  
    288277      ! "zonal" mean advective heat and salt transport  
     
    324313         DO jj = 1, jpj 
    325314            DO ji = 1, jpi 
    326                z0w = zt1(ji,jj,jk) * zt1(ji,jj,jk+1)  
    327                IF( z0w > 0. ) THEN 
    328                   ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) ) 
    329                ELSE 
    330                   ztp1(ji,jj,jk) = 0.e0 
    331                ENDIF 
    332                z1w = zs1(ji,jj,jk) * zs1(ji,jj,jk+1)  
    333                IF( z1w > 0. ) THEN 
    334                   zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) ) 
    335                ELSE 
    336                   zsp1(ji,jj,jk) = 0.e0 
    337                ENDIF 
     315               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   & 
     316                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) ) 
     317               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   & 
     318                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) ) 
    338319            END DO 
    339320         END DO 
     
    357338      END DO 
    358339      ! surface values 
    359       ztp1(:,:,1) = 0.  
    360       zsp1(:,:,1) = 0. 
     340      ztp1(:,:,1) = 0.e0 
     341      zsp1(:,:,1) = 0.e0 
    361342 
    362343      ! vertical advective flux 
  • trunk/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r67 r97  
    8080      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, zstep, zta, zsa 
    8181      REAL(wp) ::   z0u, z0v, z0w 
    82       REAL(wp) ::   z1u, z1v, z1w 
    8382      REAL(wp) ::   zzt1, zzt2, zalpha 
    8483      REAL(wp) ::   zzs1, zzs2 
     
    139138      DO jk = 1, jpkm1 
    140139         DO jj = 2, jpj 
    141             DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                z0u = zt1(ji,jj,jk) * zt1(ji-1,jj,jk) 
    143                IF( z0u > 0. ) THEN 
    144                   ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk)+zt1(ji-1,jj,jk) ) 
    145                ELSE 
    146                   ztp1(ji,jj,jk) = 0.e0 
    147                ENDIF 
    148                z1u = zs1(ji,jj,jk) * zs1(ji-1,jj,jk) 
    149                IF( z1u > 0. ) THEN 
    150                   zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk)+zs1(ji-1,jj,jk) ) 
    151                ELSE 
    152                   zsp1(ji,jj,jk) = 0.e0 
    153                ENDIF 
    154  
    155                z0v = zt2(ji,jj,jk) * zt2(ji,jj-1,jk) 
    156                IF( z0v > 0. ) THEN 
    157                   ztp2(ji,jj,jk) = 0.5 * ( zt2(ji,jj,jk)+zt2(ji,jj-1,jk) ) 
    158                ELSE 
    159                   ztp2(ji,jj,jk) = 0.e0 
    160                ENDIF 
    161                z1v = zs2(ji,jj,jk) * zs2(ji,jj-1,jk) 
    162                IF( z1v > 0. ) THEN 
    163                   zsp2(ji,jj,jk) = 0.5 * ( zs2(ji,jj,jk)+zs2(ji,jj-1,jk) ) 
    164                ELSE 
    165                   zsp2(ji,jj,jk) = 0.e0 
    166                ENDIF 
     140            DO ji = fs_2, jpi   ! vector opt. 
     141               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   & 
     142                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) ) 
     143               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   & 
     144                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) ) 
     145               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   & 
     146                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) ) 
     147               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   & 
     148                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) ) 
    167149            END DO 
    168150         END DO 
     
    172154      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0 
    173155 
    174 ! Slopes limitation 
     156      ! Slopes limitation 
    175157      DO jk = 1, jpkm1 
    176158         DO jj = 2, jpj 
    177             DO ji = fs_2, fs_jpim1   ! vector opt. 
     159            DO ji = fs_2, jpi   ! vector opt. 
    178160               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   & 
    179161                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   & 
     
    346328      END DO         
    347329 
     330      IF(l_ctl) THEN 
     331         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     332         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     333         WRITE(numout,*) ' had  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' muscl' 
     334         t_ctl = zta   ;   s_ctl = zsa 
     335      ENDIF 
     336 
    348337#if defined key_diaptr 
    349338      ! "zonal" mean advective heat and salt transport 
     
    384373         DO jj = 1, jpj 
    385374            DO ji = 1, jpi 
    386                z0w = zt1(ji,jj,jk) * zt1(ji,jj,jk+1)  
    387                IF( z0w > 0. ) THEN 
    388                   ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) ) 
    389                ELSE 
    390                   ztp1(ji,jj,jk) = 0.e0 
    391                ENDIF 
    392                z1w = zs1(ji,jj,jk) * zs1(ji,jj,jk+1)  
    393                IF( z1w > 0. ) THEN 
    394                   zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) ) 
    395                ELSE 
    396                   zsp1(ji,jj,jk) = 0.e0 
    397                ENDIF 
     375               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   & 
     376                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) ) 
     377               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   & 
     378                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) ) 
    398379            END DO 
    399380         END DO 
     
    417398      END DO 
    418399      ! surface values 
    419       ztp1(:,:,1) = 0.  
    420       zsp1(:,:,1) = 0. 
     400      ztp1(:,:,1) = 0.e0 
     401      zsp1(:,:,1) = 0.e0 
    421402 
    422403      ! vertical advective flux 
Note: See TracChangeset for help on using the changeset viewer.