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 7698 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 – NEMO

Ignore:
Timestamp:
2017-02-18T10:02:03+01:00 (7 years ago)
Author:
mocavero
Message:

update trunk with OpenMP parallelization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r7646 r7698  
    106106         CALL lim_column_sum (jpl,   v_s, vt_s_init) 
    107107         CALL lim_column_sum_energy (jpl, nlay_i,   e_i, et_i_init) 
    108          dummy_es(:,:,:) = e_s(:,:,1,:) 
     108         DO jl = 1, jpl 
     109!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     110            DO jj = 1, jpj 
     111               DO ji = 1, jpi 
     112                  dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 
     113               END DO 
     114            END DO 
     115         END DO 
    109116         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 
    110117      ENDIF 
     
    121128      ENDIF 
    122129 
    123       zdhice(:,:,:) = 0._wp 
     130!$OMP PARALLEL 
     131      DO jl = 1, jpl 
     132!$OMP DO schedule(static) private(jj,ji) 
     133         DO jj = 1, jpj 
     134            DO ji = 1, jpi 
     135               zdhice(ji,jj,jl) = 0._wp 
     136            END DO 
     137         END DO 
     138      END DO 
    124139      DO jl = klbnd, kubnd 
     140!$OMP DO schedule(static) private(jj,ji,rswitch) 
    125141         DO jj = 1, jpj 
    126142            DO ji = 1, jpi 
     
    137153      !  2) Compute fractional ice area in each grid cell 
    138154      !----------------------------------------------------------------------------------------------- 
    139       at_i(:,:) = 0._wp 
     155!$OMP DO schedule(static) private(jj,ji) 
     156      DO jj = 1, jpj 
     157         DO ji = 1, jpi 
     158            at_i(ji,jj) = 0._wp 
     159         END DO 
     160      END DO 
    140161      DO jl = klbnd, kubnd 
    141          at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    142       END DO 
     162!$OMP DO schedule(static) private(jj,ji) 
     163         DO jj = 1, jpj 
     164            DO ji = 1, jpi 
     165               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
     166            END DO 
     167         END DO 
     168      END DO 
     169!$OMP END PARALLEL 
    143170 
    144171      !----------------------------------------------------------------------------------------------- 
     
    163190      !----------------------------------------------------------------------------------------------- 
    164191      !- 4.1 Compute category boundaries 
    165       zhbnew(:,:,:) = 0._wp 
     192!$OMP PARALLEL 
     193      DO jl = 0, jpl 
     194!$OMP DO schedule(static) private(jj,ji) 
     195         DO jj = 1, jpj 
     196            DO ji = 1, jpi 
     197               zhbnew(ji,jj,jl) = 0._wp 
     198            END DO 
     199         END DO 
     200      END DO 
    166201 
    167202      DO jl = klbnd, kubnd - 1 
     203!$OMP DO schedule(static) private(ji,ii,ij,zslope) 
    168204         DO ji = 1, nbrem 
    169205            ii = nind_i(ji) 
     
    183219 
    184220         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
     221!$OMP DO schedule(static) private(ji,ii,ij) 
    185222         DO ji = 1, nbrem 
    186223            ii = nind_i(ji) 
     
    205242 
    206243      END DO 
     244!$OMP END PARALLEL 
    207245 
    208246      !----------------------------------------------------------------------------------------------- 
     
    223261      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 
    224262      !----------------------------------------------------------------------------------------------- 
     263!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    225264      DO jj = 1, jpj 
    226265         DO ji = 1, jpi 
     
    254293 
    255294      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd) 
     295!$OMP PARALLEL DO schedule(static) private(ji,ii,ij,zdh0,zetamax,zx1,zx2,zda0,zdamax) 
    256296      DO ji = 1, nbrem 
    257297         ii = nind_i(ji)  
     
    299339      !----------------------------------------------------------------------------------------------- 
    300340 
     341!$OMP PARALLEL 
    301342      DO jl = klbnd, kubnd - 1 
     343!$OMP DO schedule(static) private(jj,ji) 
    302344         DO jj = 1, jpj 
    303345            DO ji = 1, jpi 
     
    308350         END DO 
    309351 
     352!$OMP DO schedule(static) private(ji,ii,ij,zetamax,zetamin,zx1,zwk1,zwk2,zx2,zx3,nd) 
    310353         DO ji = 1, nbrem 
    311354            ii = nind_i(ji) 
     
    342385         END DO 
    343386      END DO 
     387!$OMP END PARALLEL 
    344388 
    345389      !!---------------------------------------------------------------------------------------------- 
     
    352396      !!---------------------------------------------------------------------------------------------- 
    353397 
     398!$OMP PARALLEL DO schedule(static) private(ji,ii,ij) 
    354399      DO ji = 1, nbrem 
    355400         ii = nind_i(ji) 
     
    377422         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    378423 
    379          dummy_es(:,:,:) = e_s(:,:,1,:) 
     424         DO jl = 1, jpl 
     425!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     426            DO jj = 1, jpj 
     427               DO ji = 1, jpi 
     428                  dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 
     429               END DO 
     430            END DO 
     431         END DO 
    380432         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final) 
    381433         fieldid = ' e_s : limitd_th ' 
     
    421473      !!------------------------------------------------------------------ 
    422474      ! 
     475!$OMP PARALLEL DO schedule(static) private(jj,ji,zh13,zh23,zdhr,zwk1,zwk2) 
    423476      DO jj = 1, jpj 
    424477         DO ji = 1, jpi 
     
    500553 
    501554      DO jl = klbnd, kubnd 
    502          zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
     555!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     556         DO jj = 1, jpj 
     557            DO ji = 1, jpi 
     558               zaTsfn(ji,jj,jl) = a_i(ji,jj,jl) * t_su(ji,jj,jl) 
     559            END DO 
     560         END DO 
    503561      END DO 
    504562 
     
    519577         END DO 
    520578 
     579!$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,rswitch,zdvsnow,zdesnow,zdo_aice,zdsm_vice,zdaTsf) 
    521580         DO ji = 1, nbrem  
    522581            ii = nind_i(ji) 
     
    584643 
    585644         DO jk = 1, nlay_i 
     645!$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,zdeice) 
    586646            DO ji = 1, nbrem 
    587647               ii = nind_i(ji) 
     
    608668 
    609669      DO jl = klbnd, kubnd 
     670!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    610671         DO jj = 1, jpj 
    611672            DO ji = 1, jpi  
     
    663724      ! 1) Compute ice thickness. 
    664725      !------------------------------------------------------------------------------ 
     726!$OMP PARALLEL 
    665727      DO jl = klbnd, kubnd 
     728!$OMP DO schedule(static) private(jj,ji,rswitch) 
    666729         DO jj = 1, jpj 
    667730            DO ji = 1, jpi  
     
    680743      !------------------------- 
    681744      DO jl = klbnd, kubnd 
    682          zdonor(:,:,jl) = 0 
    683          zdaice(:,:,jl) = 0._wp 
    684          zdvice(:,:,jl) = 0._wp 
    685       END DO 
     745!$OMP DO schedule(static) private(jj,ji) 
     746         DO jj = 1, jpj 
     747            DO ji = 1, jpi 
     748               zdonor(ji,jj,jl) = 0 
     749               zdaice(ji,jj,jl) = 0._wp 
     750               zdvice(ji,jj,jl) = 0._wp 
     751            END DO 
     752         END DO 
     753      END DO 
     754!$OMP END PARALLEL 
    686755 
    687756      !------------------------- 
     
    696765         zshiftflag = 0 
    697766 
     767!$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    698768         DO jj = 1, jpj  
    699769            DO ji = 1, jpi  
     
    716786            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    717787            ! Reset shift parameters 
    718             zdonor(:,:,jl) = 0 
    719             zdaice(:,:,jl) = 0._wp 
    720             zdvice(:,:,jl) = 0._wp 
     788!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     789            DO jj = 1, jpj 
     790               DO ji = 1, jpi 
     791                  zdonor(ji,jj,jl) = 0 
     792                  zdaice(ji,jj,jl) = 0._wp 
     793                  zdvice(ji,jj,jl) = 0._wp 
     794               END DO 
     795            END DO 
    721796         ENDIF 
    722797         ! 
     
    734809         zshiftflag = 0 
    735810 
     811!$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    736812         DO jj = 1, jpj 
    737813            DO ji = 1, jpi 
    738814               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    739                   ! 
    740815                  zshiftflag = 1 
    741816                  zdonor(ji,jj,jl) = jl + 1 
     
    751826            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    752827            ! Reset shift parameters 
    753             zdonor(:,:,jl) = 0 
    754             zdaice(:,:,jl) = 0._wp 
    755             zdvice(:,:,jl) = 0._wp 
     828!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     829            DO jj = 1, jpj 
     830               DO ji = 1, jpi 
     831                  zdonor(ji,jj,jl) = 0 
     832                  zdaice(ji,jj,jl) = 0._wp 
     833                  zdvice(ji,jj,jl) = 0._wp 
     834               END DO 
     835            END DO 
    756836         ENDIF 
    757837 
Note: See TracChangeset for help on using the changeset viewer.