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 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 – NEMO

Ignore:
Timestamp:
2017-03-03T12:46:59+01:00 (7 years ago)
Author:
mocavero
Message:

Reverting trunk to remove OpenMP

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7698 r7753  
    161161      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    162162      IF ( iom_use("sbt") ) THEN 
    163 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    164163         DO jj = 1, jpj 
    165164            DO ji = 1, jpi 
     
    174173      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    175174      IF ( iom_use("sbs") ) THEN 
    176 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    177175         DO jj = 1, jpj 
    178176            DO ji = 1, jpi 
     
    185183 
    186184      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    187 !$OMP PARALLEL 
    188 !$OMP DO schedule(static) private(jj, ji) 
    189          DO jj = 1, jpj 
    190             DO ji = 1, jpi 
    191                z2d(ji,jj) = 0._wp 
    192             END DO 
    193          END DO 
    194 !$OMP DO schedule(static) private(jj, ji, zztmpx,zztmpy) 
     185         z2d(:,:) = 0._wp 
    195186         DO jj = 2, jpjm1 
    196187            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    203194            ENDDO 
    204195         ENDDO 
    205 !$OMP END PARALLEL 
    206196         CALL lbc_lnk( z2d, 'T', 1. ) 
    207197         CALL iom_put( "taubot", z2d )            
     
    211201      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    212202      IF ( iom_use("sbu") ) THEN 
    213 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    214203         DO jj = 1, jpj 
    215204            DO ji = 1, jpi 
     
    224213      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    225214      IF ( iom_use("sbv") ) THEN 
    226 !$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot) 
    227215         DO jj = 1, jpj 
    228216            DO ji = 1, jpi 
     
    237225      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    238226         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    239 !$OMP PARALLEL 
    240 !$OMP DO schedule(static) private(jj, ji) 
    241          DO jj = 1, jpj 
    242             DO ji = 1, jpi 
    243                z2d(ji,jj) = rau0 * e1e2t(ji,jj) 
    244             END DO 
    245          END DO 
    246 !$OMP DO schedule(static) private(jk,jj,ji) 
     227         z2d(:,:) = rau0 * e1e2t(:,:) 
    247228         DO jk = 1, jpk 
    248             DO jj = 1, jpj 
    249                DO ji = 1, jpi 
    250                   z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 
    251                END DO 
    252             END DO 
    253          END DO 
    254 !$OMP END PARALLEL 
     229            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     230         END DO 
    255231         CALL iom_put( "w_masstr" , z3d )   
    256232         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
     
    265241 
    266242      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    267 !$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy) 
    268243         DO jj = 2, jpjm1                                    ! sst gradient 
    269244            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    277252         CALL lbc_lnk( z2d, 'T', 1. ) 
    278253         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    279 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    280          DO jj = 1, jpj 
    281             DO ji = 1, jpi 
    282                z2d(ji,jj) = SQRT( z2d(ji,jj) ) 
    283             END DO 
    284          END DO 
     254         z2d(:,:) = SQRT( z2d(:,:) ) 
    285255         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    286256      ENDIF 
     
    288258      ! clem: heat and salt content 
    289259      IF( iom_use("heatc") ) THEN 
    290 !$OMP PARALLEL 
    291 !$OMP DO schedule(static) private(jj, ji) 
    292          DO jj = 1, jpj 
    293             DO ji = 1, jpi 
    294                z2d(ji,jj) = 0._wp 
    295             END DO 
    296          END DO 
     260         z2d(:,:)  = 0._wp  
    297261         DO jk = 1, jpkm1 
    298 !$OMP DO schedule(static) private(jj, ji) 
    299262            DO jj = 1, jpj 
    300263               DO ji = 1, jpi 
     
    303266            END DO 
    304267         END DO 
    305 !$OMP END PARALLEL 
    306268         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
    307269      ENDIF 
    308270 
    309271      IF( iom_use("saltc") ) THEN 
    310 !$OMP PARALLEL 
    311 !$OMP DO schedule(static) private(jj, ji) 
    312          DO jj = 1, jpj 
    313             DO ji = 1, jpi 
    314                z2d(ji,jj) = 0._wp 
    315             END DO 
    316          END DO 
     272         z2d(:,:)  = 0._wp  
    317273         DO jk = 1, jpkm1 
    318 !$OMP DO schedule(static) private(jj, ji) 
    319274            DO jj = 1, jpj 
    320275               DO ji = 1, jpi 
     
    323278            END DO 
    324279         END DO 
    325 !$OMP END PARALLEL 
    326280         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
    327281      ENDIF 
    328282      ! 
    329283      IF ( iom_use("eken") ) THEN 
    330 !$OMP PARALLEL 
    331 !$OMP DO schedule(static) private(jj, ji) 
    332          DO jj = 1, jpj 
    333             DO ji = 1, jpi 
    334                rke(ji,jj,jk) = 0._wp                               !      kinetic energy  
    335             END DO 
    336          END DO 
    337 !$OMP DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 
     284         rke(:,:,jk) = 0._wp                               !      kinetic energy  
    338285         DO jk = 1, jpkm1 
    339286            DO jj = 2, jpjm1 
     
    353300            ENDDO 
    354301         ENDDO 
    355 !$OMP END PARALLEL 
    356302         CALL lbc_lnk( rke, 'T', 1. ) 
    357303         CALL iom_put( "eken", rke )            
     
    361307      ! 
    362308      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    363 !$OMP PARALLEL 
    364 !$OMP DO schedule(static) private(jj, ji) 
    365          DO jj = 1, jpj 
    366             DO ji = 1, jpi 
    367                z3d(ji,jj,jpk) = 0.e0 
    368                z2d(ji,jj) = 0.e0 
    369             END DO 
    370          END DO 
     309         z3d(:,:,jpk) = 0.e0 
     310         z2d(:,:) = 0.e0 
    371311         DO jk = 1, jpkm1 
    372 !$OMP DO schedule(static) private(jj, ji) 
    373             DO jj = 1, jpj 
    374                DO ji = 1, jpi 
    375                   z3d(ji,jj,jk) = rau0 * un(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    376                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 
    377                END DO 
    378             END DO 
    379          END DO 
    380 !$OMP END PARALLEL 
     312            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     313            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     314         END DO 
    381315         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    382316         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
     
    384318       
    385319      IF( iom_use("u_heattr") ) THEN 
    386 !$OMP PARALLEL 
    387 !$OMP DO schedule(static) private(jj, ji) 
    388          DO jj = 1, jpj 
    389             DO ji = 1, jpi 
    390                z2d(ji,jj) = 0.e0 
    391             END DO 
    392          END DO 
     320         z2d(:,:) = 0.e0  
    393321         DO jk = 1, jpkm1 
    394 !$OMP DO schedule(static) private(jj, ji) 
    395322            DO jj = 2, jpjm1 
    396323               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    399326            END DO 
    400327         END DO 
    401 !$OMP END PARALLEL 
    402328         CALL lbc_lnk( z2d, 'U', -1. ) 
    403329         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
     
    405331 
    406332      IF( iom_use("u_salttr") ) THEN 
    407 !$OMP PARALLEL 
    408 !$OMP DO schedule(static) private(jj, ji) 
    409          DO jj = 1, jpj 
    410             DO ji = 1, jpi 
    411                z2d(ji,jj) = 0.e0 
    412             END DO 
    413          END DO 
     333         z2d(:,:) = 0.e0  
    414334         DO jk = 1, jpkm1 
    415 !$OMP DO schedule(static) private(jj, ji) 
    416335            DO jj = 2, jpjm1 
    417336               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    420339            END DO 
    421340         END DO 
    422 !$OMP END PARALLEL 
    423341         CALL lbc_lnk( z2d, 'U', -1. ) 
    424342         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
     
    427345       
    428346      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    429 !$OMP PARALLEL 
    430 !$OMP DO schedule(static) private(jj, ji) 
    431          DO jj = 1, jpj 
    432             DO ji = 1, jpi 
    433                z3d(ji,jj,jpk) = 0.e0 
    434             END DO 
    435          END DO 
    436 !$OMP DO schedule(static) private(jk,jj,ji) 
     347         z3d(:,:,jpk) = 0.e0 
    437348         DO jk = 1, jpkm1 
    438             DO jj = 1, jpj 
    439                DO ji = 1, jpi 
    440                   z3d(ji,jj,jk) = rau0 * vn(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    441                END DO 
    442             END DO 
    443          END DO 
    444 !$OMP END PARALLEL 
     349            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     350         END DO 
    445351         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
    446352      ENDIF 
    447353       
    448354      IF( iom_use("v_heattr") ) THEN 
    449 !$OMP PARALLEL 
    450 !$OMP DO schedule(static) private(jj, ji) 
    451          DO jj = 1, jpj 
    452             DO ji = 1, jpi 
    453                z2d(ji,jj) = 0.e0 
    454             END DO 
    455          END DO 
     355         z2d(:,:) = 0.e0  
    456356         DO jk = 1, jpkm1 
    457 !$OMP DO schedule(static) private(jj, ji) 
    458357            DO jj = 2, jpjm1 
    459358               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    462361            END DO 
    463362         END DO 
    464 !$OMP END PARALLEL 
    465363         CALL lbc_lnk( z2d, 'V', -1. ) 
    466364         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
     
    468366 
    469367      IF( iom_use("v_salttr") ) THEN 
    470 !$OMP PARALLEL 
    471 !$OMP DO schedule(static) private(jj, ji) 
    472          DO jj = 1, jpj 
    473             DO ji = 1, jpi 
    474                z2d(ji,jj) = 0.e0 
    475             END DO 
    476          END DO 
     368         z2d(:,:) = 0.e0  
    477369         DO jk = 1, jpkm1 
    478 !$OMP DO schedule(static) private(jj, ji) 
    479370            DO jj = 2, jpjm1 
    480371               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    483374            END DO 
    484375         END DO 
    485 !$OMP END PARALLEL 
    486376         CALL lbc_lnk( z2d, 'V', -1. ) 
    487377         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
     
    490380      ! Vertical integral of temperature 
    491381      IF( iom_use("tosmint") ) THEN 
    492 !$OMP PARALLEL 
    493 !$OMP DO schedule(static) private(jj, ji) 
    494          DO jj = 1, jpj 
    495             DO ji = 1, jpi 
    496                z2d(ji,jj) = 0.e0 
    497             END DO 
    498          END DO 
     382         z2d(:,:)=0._wp 
    499383         DO jk = 1, jpkm1 
    500 !$OMP DO schedule(static) private(jj, ji) 
    501384            DO jj = 2, jpjm1 
    502385               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    505388            END DO 
    506389         END DO 
    507 !$OMP END PARALLEL 
    508390         CALL lbc_lnk( z2d, 'T', -1. ) 
    509391         CALL iom_put( "tosmint", z2d )  
     
    512394      ! Vertical integral of salinity 
    513395      IF( iom_use("somint") ) THEN 
    514 !$OMP PARALLEL 
    515 !$OMP DO schedule(static) private(jj, ji) 
    516          DO jj = 1, jpj 
    517             DO ji = 1, jpi 
    518                z2d(ji,jj) = 0.e0 
    519             END DO 
    520          END DO 
     396         z2d(:,:)=0._wp 
    521397         DO jk = 1, jpkm1 
    522 !$OMP DO schedule(static) private(jj, ji) 
    523398            DO jj = 2, jpjm1 
    524399               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    527402            END DO 
    528403         END DO 
    529 !$OMP END PARALLEL 
    530404         CALL lbc_lnk( z2d, 'T', -1. ) 
    531405         CALL iom_put( "somint", z2d )  
     
    918792      ENDIF 
    919793      IF( .NOT.ln_linssh ) THEN 
    920 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    921          DO jk = 1, jpk 
    922             DO jj = 1, jpj 
    923                DO ji = 1, jpi 
    924                   zw3d(ji,jj,jk) = ( ( e3t_n(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100 * tmask(ji,jj,jk) ) ** 2 
    925                END DO 
    926             END DO 
    927          END DO 
     794         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    928795         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    929796         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
     
    937804                                                                                  ! in linear free surface case) 
    938805      IF( ln_linssh ) THEN 
    939 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    940          DO jj = 1, jpj 
    941             DO ji = 1, jpi 
    942                zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_tem) 
    943             END DO 
    944          END DO 
     806         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
    945807         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    946 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    947          DO jj = 1, jpj 
    948             DO ji = 1, jpi 
    949                zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_sal) 
    950             END DO 
    951          END DO 
     808         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
    952809         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    953810      ENDIF 
     
    985842         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    986843         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    987          IF( ln_ssr ) THEN 
    988 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    989             DO jj = 1, jpj 
    990                DO ji = 1, jpi 
    991                   zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
    992                END DO 
    993             END DO 
    994          END IF 
     844         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    995845         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    996846      ENDIF 
     
    998848         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    999849         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    1000          IF( ln_ssr ) THEN 
    1001 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    1002             DO jj = 1, jpj 
    1003                DO ji = 1, jpi 
    1004                   zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
    1005                END DO 
    1006             END DO 
    1007          END IF 
     850         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    1008851         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    1009852      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.