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/TOP_SRC – NEMO

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

update trunk with OpenMP parallelization

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
31 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90

    r7646 r7698  
    5656      IF( ln_p4z ) THEN 
    5757         ! 
     58!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zagg1,zagg2,zagg3,zagg4,zagg,zaggfe,zaggdoc,zaggdoc2,zaggdoc3) 
    5859         DO jk = 1, jpkm1 
    5960            DO jj = 1, jpj 
    … …  
    102103      ELSE    ! ln_p5z 
    103104        ! 
     105!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact,zaggtmp,zaggfe,zaggpoc,zaggpoc1,zaggpoc2,zaggpoc3,zaggpoc4) & 
     106!$OMP& private(zaggpon,zaggpop,zaggdoc,zaggdon,zaggdop,zaggdoc2,zaggdon2,zaggdop2,zaggdoc3,zaggdon3,zaggdop3) 
    104107         DO jk = 1, jpkm1 
    105108            DO jj = 1, jpj 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r7646 r7698  
    6666      !     OF PHYTOPLANKTON AND DETRITUS 
    6767 
    68       xdiss(:,:,:) = 1. 
     68!$OMP PARALLEL 
     69!$OMP DO schedule(static) private(jk,jj,ji) 
     70      DO jk = 1, jpk 
     71         DO jj = 1, jpj 
     72            DO ji = 1, jpi 
     73               xdiss(ji,jj,jk) = 1. 
     74            END DO 
     75         END DO 
     76      END DO 
    6977!!gm the use of nmld should be better here? 
     78!$OMP DO schedule(static) private(jk,jj,ji) 
    7079      DO jk = 2, jpkm1 
    7180         DO jj = 1, jpj 
    … …  
    7685         END DO 
    7786      END DO 
     87!$OMP END PARALLEL 
    7888 
    7989      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r7646 r7698  
    132132   !!---------------------------------------------------------------------- 
    133133   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    134    !! $Id$  
     134   !! $Id$ 
    135135   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    136136   !!---------------------------------------------------------------------- 
    … …  
    165165      ! ------------------------------------------------------------- 
    166166      IF (neos == -1) THEN 
    167          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     167!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     168         DO jk = 1, jpk 
     169            DO jj = 1, jpj 
     170               DO ji = 1, jpi 
     171                  salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * 35.0 / 35.16504 
     172            END DO 
     173          END DO 
     174        END DO 
    168175      ELSE 
    169          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     176!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     177         DO jk = 1, jpk 
     178            DO jj = 1, jpj 
     179               DO ji = 1, jpi 
     180                  salinprac(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 
     181            END DO 
     182          END DO 
     183        END DO 
    170184      ENDIF 
    171185 
    … …  
    176190      ! 0.04°C relative to an exact computation 
    177191      ! --------------------------------------------------------------------- 
     192!$OMP PARALLEL 
     193!$OMP DO schedule(static) private(jk,jj,ji,zpres,za1,za2) 
    178194      DO jk = 1, jpk 
    179195         DO jj = 1, jpj 
    … …  
    190206      ! ---------------------------------- 
    191207!CDIR NOVERRCHK 
     208!$OMP DO schedule(static) private(jj,ji,ztkel,zt,zsal,zcek1) 
    192209      DO jj = 1, jpj 
    193210!CDIR NOVERRCHK 
    … …  
    211228      ! ------------------------------- 
    212229!CDIR NOVERRCHK 
     230!$OMP DO schedule(static) private(jk,jj,ji,ztkel,zsal,zsal2,ztgg,ztgg2,ztgg3,ztgg4,ztgg5,zoxy) 
    213231      DO jk = 1, jpk 
    214232!CDIR NOVERRCHK 
    … …  
    239257      ! ------------------------------- 
    240258!CDIR NOVERRCHK 
     259!$OMP DO schedule(static) private(jk,jj,ji,zplat,zc1,zpres,ztkel,zsal,zsqrt,zsal15,zlogt,ztr,zis,zis2,zisqrt,ztc,zcl,zst) & 
     260!$OMP& private(zft,zcks,zckf,zckb,zck1,zck2,zckw,zck1p,zck2p,zck3p,zcksi,zaksp0,total2free,free2SWS,total2SWS,SWS2total,zak1,zak2,zakb,zakw,zaksp1,zak1p,zak2p,zak3p,zaksi,zcpexp,zcpexp2,zbuf1,zbuf2,ztkel1) 
    241261      DO jk = 1, jpk 
    242262!CDIR NOVERRCHK 
    … …  
    446466         END DO 
    447467      END DO 
     468!$OMP END PARALLEL 
    448469      ! 
    449470      IF( nn_timing == 1 )  CALL timing_stop('p4z_che') 
    … …  
    473494      IF( nn_timing == 1 )  CALL timing_start('ahini_for_at') 
    474495      ! 
     496!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,p_alkcb,p_dictot,p_bortot,zca1,zba1,za2,za1,za0,zd,zsqrtd,zhmin) 
    475497      DO jk = 1, jpk 
    476498        DO jj = 1, jpj 
    … …  
    515537      ! 
    516538   END SUBROUTINE ahini_for_at 
    517  
    518539   !=============================================================================== 
    519540   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
    … …  
    526547   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    527548   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
    528  
    529    p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
    530    &              - fluorid(:,:,:) 
    531    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
    532    &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
     549   INTEGER   ::  ji, jj, jk 
     550!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     551   DO jk = 1, jpk 
     552      DO jj = 1, jpj 
     553         DO ji = 1, jpi 
     554            p_alknw_inf(ji,jj,jk) =  -trb(ji,jj,jk,jppo4) * 1000. / (rhop(ji,jj,jk) + rtrn) - sulfat(ji,jj,jk)  & 
     555            &              - fluorid(ji,jj,jk) 
     556            p_alknw_sup(ji,jj,jk) =   (2. * trb(ji,jj,jk,jpdic) + 2. * trb(ji,jj,jk,jppo4) + trb(ji,jj,jk,jpsil) )    & 
     557            &               * 1000. / (rhop(ji,jj,jk) + rtrn) + borat(ji,jj,jk) 
     558         END DO 
     559      END DO 
     560   END DO 
    533561 
    534562   END SUBROUTINE anw_infsup 
    … …  
    571599   CALL anw_infsup( zalknw_inf, zalknw_sup ) 
    572600 
    573    rmask(:,:,:) = tmask(:,:,:) 
    574    zhi(:,:,:)   = 0. 
     601!$OMP PARALLEL 
     602!$OMP DO schedule(static) private(jk,jj,ji) 
     603   DO jk = 1, jpk 
     604      DO jj = 1, jpj 
     605         DO ji = 1, jpi 
     606            rmask(ji,jj,jk) = tmask(ji,jj,jk) 
     607            zhi(ji,jj,jk)   = 0. 
     608         END DO 
     609      END DO 
     610   END DO 
    575611 
    576612   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
     613!$OMP DO schedule(static) private(jk,jj,ji,p_alktot,aphscale,zh_ini,zdelta) 
    577614   DO jk = 1, jpk 
    578615      DO jj = 1, jpj 
    … …  
    605642   END DO 
    606643 
    607    zeqn_absmin(:,:,:) = HUGE(1._wp) 
     644!$OMP DO schedule(static) private(jk,jj,ji) 
     645   DO jk = 1, jpk 
     646      DO jj = 1, jpj 
     647         DO ji = 1, jpi 
     648            zeqn_absmin(ji,jj,jk) = HUGE(1._wp) 
     649         END DO 
     650      END DO 
     651   END DO 
    608652 
    609653   DO jn = 1, jp_maxniter_atgen  
     654!$OMP DO schedule(static) private(jk,jj,ji,zfact,p_alktot,zdic,zbot,zpt,zsit,zst,zft,zh,zh_prev,znumer_dic) & 
     655!$OMP& private(zdenom_dic,zalk_dic,zdnumer_dic,zdalk_dic,znumer_bor,zdenom_bor,zalk_bor,zdnumer_bor,zdalk_bor) & 
     656!$OMP& private(znumer_po4,zdenom_po4,zalk_po4,zdnumer_po4,zdalk_po4,znumer_sil,zdenom_sil,zalk_sil,zdnumer_sil) & 
     657!$OMP& private(zdalk_sil,aphscale,znumer_so4,zdenom_so4,zalk_so4,zdnumer_so4,zdalk_so4,znumer_flu,zdenom_flu) & 
     658!$OMP& private(zalk_flu,zdnumer_flu,zdalk_flu,zalk_wat,zdalk_wat,zeqn,zalka,zdeqndh,zh_lnfactor,zh_delta,l_exitnow) 
    610659   DO jk = 1, jpk 
    611660      DO jj = 1, jpj 
    … …  
    796845   END DO 
    797846   END DO 
     847!$OMP END PARALLEL 
    798848   ! 
    799849   CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r7646 r7698  
    8383      ! Allocate temporary workspace 
    8484      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 
    85       zFe3 (:,:,:) = 0. 
    86       zFeL1(:,:,:) = 0. 
    87       zTL1 (:,:,:) = 0. 
    88       IF( ln_fechem ) THEN 
    89          CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 ) 
    90          CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
    91          zFe2 (:,:,:) = 0. 
    92          zFeL2(:,:,:) = 0. 
    93          zTL2 (:,:,:) = 0. 
    94          zFeP (:,:,:) = 0. 
    95       ENDIF 
     85!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     86      DO jk = 1, jpk 
     87         DO jj = 1, jpj 
     88            DO ji = 1, jpi 
     89               zFe3 (ji,jj,jk) = 0. 
     90               zFeL1(ji,jj,jk) = 0. 
     91               zTL1 (ji,jj,jk) = 0. 
     92            END DO 
     93         END DO 
     94      END DO 
    9695 
    9796      ! Total ligand concentration : Ligands can be chosen to be constant or variable 
    … …  
    9998      ! ------------------------------------------------- 
    10099      IF( ln_ligvar ) THEN 
    101          ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
    102          ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
     100!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     101         DO jk = 1, jpk 
     102            DO jj = 1, jpj 
     103               DO ji = 1, jpi 
     104                  ztotlig(ji,jj,jk) =  0.09 * trb(ji,jj,jk,jpdoc) * 1E6 + ligand * 1E9 
     105                  ztotlig(ji,jj,jk) =  MIN( ztotlig(ji,jj,jk), 10. ) 
     106               END DO 
     107            END DO 
     108         END DO 
    103109      ELSE 
    104         IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
    105         ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
     110        IF( ln_ligand ) THEN 
     111!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     112           DO jk = 1, jpk 
     113              DO jj = 1, jpj 
     114                 DO ji = 1, jpi 
     115                    ztotlig(ji,jj,jk) = trb(ji,jj,jk,jplgw) * 1E9 
     116                 END DO 
     117              END DO 
     118           END DO 
     119        ELSE               
     120!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     121           DO jk = 1, jpk 
     122              DO jj = 1, jpj 
     123                 DO ji = 1, jpi 
     124                    ztotlig(ji,jj,jk) = ligand * 1E9 
     125                 END DO 
     126              END DO 
     127           END DO 
    106128        ENDIF 
    107129      ENDIF 
    108130 
    109131      IF( ln_fechem ) THEN 
     132         CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 ) 
     133         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
    110134         ! compute the day length depending on latitude and the day 
    111135         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
    112136         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
    113137 
     138!$OMP PARALLEL 
     139!$OMP DO schedule(static) private(jk,jj,ji) 
     140         DO jk = 1, jpk 
     141            DO jj = 1, jpj 
     142               DO ji = 1, jpi 
     143                  zFe2 (ji,jj,jk) = 0. 
     144                  zFeL2(ji,jj,jk) = 0. 
     145                  zTL2 (ji,jj,jk) = 0. 
     146                  zFeP (ji,jj,jk) = 0. 
     147               END DO 
     148            END DO 
     149         END DO 
    114150         ! day length in hours 
    115          zstrn(:,:) = 0. 
     151!$OMP DO schedule(static) private(jj,ji) 
     152         DO jj = 1, jpj 
     153            DO ji = 1, jpi 
     154               zstrn(ji,jj) = 0. 
     155            END DO 
     156         END DO 
     157!$OMP DO schedule(static) private(jj,ji,zargu) 
    116158         DO jj = 1, jpj 
    117159            DO ji = 1, jpi 
    … …  
    123165 
    124166         ! Maximum light intensity 
    125          zstrn2(:,:) = zstrn(:,:) / 24. 
    126          WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    127          zstrn(:,:) = 24. / zstrn(:,:) 
     167!$OMP DO schedule(static) private(jj,ji) 
     168         DO jj = 1, jpj 
     169            DO ji = 1, jpi 
     170               zstrn2(ji,jj) = zstrn(ji,jj) / 24. 
     171               IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 
     172               zstrn(ji,jj) = 24. / zstrn(ji,jj) 
     173            END DO 
     174         END DO 
    128175 
    129176         ! ------------------------------------------------------------ 
    … …  
    133180         ! ------------------------------------------------------------ 
    134181         DO jn = 1, 2 
     182!$OMP DO schedule(static) private(jk,jj,ji,zzstrn2,ztligand,zph,zoxy,zkox,zkph2,zkph1,ztfe,za) & 
     183!$OMP& private(zb,zc,zkappa1,zkappa2,za2,za1,za0,zp,zq,zp3,zq2,zd,zr,zphi,zxs,zfff,jic,zfunc) & 
     184!$OMP& private(zlight,zzFe3,zzFep,zzFeL2,zzFeL1,zzFe2) 
    135185          DO jk = 1, jpkm1 
    136186            DO jj = 1, jpj 
    … …  
    213263         END DO 
    214264         END DO 
     265!$OMP END PARALLEL 
    215266      ELSE 
    216267         ! ------------------------------------------------------------ 
    … …  
    219270         ! Chemistry is supposed to be fast enough to be at equilibrium 
    220271         ! ------------------------------------------------------------ 
     272!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zkeq,zfesatur,ztfe) 
    221273         DO jk = 1, jpkm1 
    222274            DO jj = 1, jpj 
    … …  
    239291 
    240292      zdust = 0.         ! if no dust available 
     293!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfeequi,zfecoll,zhplus,fe3sol,ztrc,zdust) & 
     294!$OMP& private(zlam1b,zscave,zdenom1,zdenom2,zlamfac,zdep,zcoag,zlam1a,zaggdfea,zaggdfeb) 
    241295      DO jk = 1, jpkm1 
    242296         DO jj = 1, jpj 
    … …  
    308362      !  Define the bioavailable fraction of iron 
    309363      !  ---------------------------------------- 
    310       IF( ln_fechem ) THEN  ;  biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
    311       ELSE                  ;  biron(:,:,:) = trb(:,:,:,jpfer)  
     364      IF( ln_fechem ) THEN   
     365!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     366         DO jk = 1, jpk 
     367            DO jj = 1, jpj 
     368               DO ji = 1, jpi 
     369                  biron(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) - zFeP(ji,jj,jk) * 1E-9 ) 
     370               END DO 
     371            END DO 
     372         END DO 
     373      ELSE                   
     374!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     375         DO jk = 1, jpk 
     376            DO jj = 1, jpj 
     377               DO ji = 1, jpi 
     378                  biron(ji,jj,jk) = trb(ji,jj,jk,jpfer)  
     379               END DO 
     380            END DO 
     381         END DO 
    312382      ENDIF 
    313383      ! 
    314384      IF( ln_ligand ) THEN 
    315385         ! 
     386!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlam1a,zlam1b,zligco,zaggliga,zaggligb) 
    316387         DO jk = 1, jpkm1 
    317388            DO jj = 1, jpj 
    … …  
    331402         ! 
    332403         IF( .NOT.ln_fechem) THEN 
    333             plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
    334             plig(:,:,:) =  MAX( 0. , plig(:,:,:) ) 
     404!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     405            DO jk = 1, jpk 
     406               DO jj = 1, jpj 
     407                  DO ji = 1, jpi 
     408                     plig(ji,jj,jk) =  MAX( 0., ( ( zFeL1(ji,jj,jk) * 1E-9 ) / ( trb(ji,jj,jk,jpfer) +rtrn ) ) ) 
     409                     plig(ji,jj,jk) =  MAX( 0. , plig(ji,jj,jk) ) 
     410                  END DO 
     411               END DO 
     412            END DO 
    335413         ENDIF 
    336414         ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r7646 r7698  
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    56    !! $Id$  
     56   !! $Id$ 
    5757   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5858   !!---------------------------------------------------------------------- 
    … …  
    105105         zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 
    106106         atcco2  = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 
    107          satmco2(:,:) = atcco2  
    108       ENDIF 
    109  
    110       IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
    111  
     107!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     108         DO jj = 1, jpj 
     109            DO ji = 1, jpi 
     110               satmco2(ji,jj) = atcco2 
     111            END DO 
     112         END DO 
     113      ENDIF 
     114 
     115      IF( l_co2cpl ) THEN 
     116!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     117         DO jj = 1, jpj 
     118            DO ji = 1, jpi 
     119               satmco2(ji,jj) = atm_co2(ji,jj) 
     120            END DO 
     121         END DO 
     122      END IF 
     123 
     124!$OMP PARALLEL 
     125!$OMP DO schedule(static) private(jj,ji,zfact,zdic,zph) 
    112126      DO jj = 1, jpj 
    113127         DO ji = 1, jpi 
    … …  
    128142      ! ------------------------------------------- 
    129143 
     144!$OMP DO schedule(static) private(jj,ji,ztc,ztc2,ztc3,ztc4,zsch_co2,zsch_o2,zws,zkgwan) 
    130145      DO jj = 1, jpj 
    131146         DO ji = 1, jpi 
    … …  
    149164 
    150165 
     166!$OMP DO schedule(static) private(jj,ji,ztkel,zsal,zvapsw,zxc2,zfugcoeff,zfco2,zfld,zflu,zflu16) 
    151167      DO jj = 1, jpj 
    152168         DO ji = 1, jpi 
    … …  
    174190         END DO 
    175191      END DO 
     192!$OMP END PARALLEL 
    176193 
    177194      t_oce_co2_flx     = glob_sum( oce_co2(:,:) )                    !  Total Flux of Carbon 
    … …  
    189206         CALL wrk_alloc( jpi, jpj, zw2d )   
    190207         IF( iom_use( "Cflx"  ) )  THEN 
    191             zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
     208!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     209            DO jj = 1, jpj 
     210               DO ji = 1, jpi 
     211                  zw2d(ji,jj) = oce_co2(ji,jj) / e1e2t(ji,jj) * rfact2r 
     212               END DO 
     213            END DO 
    192214            CALL iom_put( "Cflx"     , zw2d )  
    193215         ENDIF 
    194216         IF( iom_use( "Oflx"  ) )  THEN 
    195             zw2d(:,:) =  zoflx(:,:) * 1000 * tmask(:,:,1) 
     217!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     218            DO jj = 1, jpj 
     219               DO ji = 1, jpi 
     220                  zw2d(ji,jj) =  zoflx(ji,jj) * 1000 * tmask(ji,jj,1) 
     221               END DO 
     222            END DO 
    196223            CALL iom_put( "Oflx" , zw2d ) 
    197224         ENDIF 
    198225         IF( iom_use( "Kg"    ) )  THEN 
    199             zw2d(:,:) =  zkgco2(:,:) * tmask(:,:,1) 
     226!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     227            DO jj = 1, jpj 
     228               DO ji = 1, jpi 
     229                  zw2d(ji,jj) =  zkgco2(ji,jj) * tmask(ji,jj,1) 
     230               END DO 
     231            END DO 
    200232            CALL iom_put( "Kg"   , zw2d ) 
    201233         ENDIF 
    202234         IF( iom_use( "Dpco2" ) ) THEN 
    203            zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
     235!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     236            DO jj = 1, jpj 
     237               DO ji = 1, jpi 
     238                  zw2d(ji,jj) = ( zpco2atm(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
     239               END DO 
     240            END DO 
    204241           CALL iom_put( "Dpco2" ,  zw2d ) 
    205242         ENDIF 
    206243         IF( iom_use( "Dpo2" ) )  THEN 
    207            zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
     244!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     245            DO jj = 1, jpj 
     246               DO ji = 1, jpi 
     247                  zw2d(ji,jj) = ( atcox * patm(ji,jj) - atcox * trb(ji,jj,1,jpoxy) / ( chemo2(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
     248               END DO 
     249            END DO 
    208250           CALL iom_put( "Dpo2"  , zw2d ) 
    209251         ENDIF 
    … …  
    232274      !!---------------------------------------------------------------------- 
    233275      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 
    234       INTEGER :: jm 
     276      INTEGER :: jm, jj, ji 
    235277      INTEGER :: ios                 ! Local integer output status for namelist read 
    236278      !!---------------------------------------------------------------------- 
    … …  
    258300            WRITE(numout,*) ' ' 
    259301         ENDIF 
    260          satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
     302!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     303         DO jj = 1, jpj 
     304            DO ji = 1, jpi 
     305               satmco2(ji,jj)  = atcco2      ! Initialisation of atmospheric pco2 
     306            END DO 
     307         END DO 
    261308      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    262309         IF(lwp)  THEN 
    … …  
    294341 
    295342      ! 
    296       oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
     343!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     344      DO jj = 1, jpj 
     345         DO ji = 1, jpi 
     346            oce_co2(ji,jj)  = 0._wp                ! Initialization of Flux of Carbon 
     347         END DO 
     348      END DO 
    297349      t_oce_co2_flx = 0._wp 
    298350      t_atm_co2_flx = 0._wp 
    … …  
    313365      !! * arguments 
    314366      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     367      INTEGER ::  jj, ji 
    315368      ! 
    316369      INTEGER            ::  ierr 
    … …  
    361414         ENDIF 
    362415         ! 
    363          IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
     416         IF( .NOT.ln_presatm ) THEN 
     417!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     418            DO jj = 1, jpj 
     419               DO ji = 1, jpi 
     420                  patm(ji,jj) = 1.e0    ! Initialize patm if no reading from a file 
     421               END DO 
     422            END DO 
     423         ENDIF 
    364424         ! 
    365425      ENDIF 
    … …  
    367427      IF( ln_presatm ) THEN 
    368428         CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2 
    369          patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure 
     429!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     430         DO jj = 1, jpj 
     431            DO ji = 1, jpi 
     432               patm(ji,jj) = sf_patm(1)%fnow(ji,jj,1)                        ! atmospheric pressure 
     433            END DO 
     434         END DO 
    370435      ENDIF 
    371436      ! 
    372437      IF( ln_presatmco2 ) THEN 
    373438         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2 
    374          satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure 
     439!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     440         DO jj = 1, jpj 
     441            DO ji = 1, jpi 
     442               satmco2(ji,jj) = sf_atmco2(1)%fnow(ji,jj,1)                        ! atmospheric pressure 
     443            END DO 
     444         END DO 
    375445      ELSE 
    376          satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file 
     446!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     447         DO jj = 1, jpj 
     448            DO ji = 1, jpi 
     449               satmco2(ji,jj) = atcco2    ! Initialize atmco2 if no reading from a file 
     450            END DO 
     451         END DO 
    377452      ENDIF 
    378453      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    r7646 r7698  
    2121   !!---------------------------------------------------------------------- 
    2222   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    23    !! $Id$  
     23   !! $Id$ 
    2424   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2525   !!---------------------------------------------------------------------- 
    … …  
    3636      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    3737      ! 
    38       INTEGER  :: ji, jj                 ! dummy loop indices 
     38      INTEGER  :: ji, jj, jk             ! dummy loop indices 
    3939      REAL(wp) :: zvar                   ! local variable 
    4040      !!--------------------------------------------------------------------- 
    … …  
    4444      ! Computation of phyto and zoo metabolic rate 
    4545      ! ------------------------------------------- 
    46       tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    47       tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
     46!$OMP PARALLEL 
     47!$OMP DO schedule(static) private(jk,jj,ji) 
     48      DO jk = 1, jpk 
     49         DO jj = 1, jpj 
     50            DO ji = 1, jpi 
     51               tgfunc (ji,jj,jk) = EXP( 0.063913 * tsn(ji,jj,jk,jp_tem) ) 
     52               tgfunc2(ji,jj,jk) = EXP( 0.07608  * tsn(ji,jj,jk,jp_tem) ) 
     53            END DO 
     54         END DO 
     55      END DO 
    4856 
    4957      ! Computation of the silicon dependant half saturation  constant for silica uptake 
    5058      ! --------------------------------------------------- 
     59!$OMP DO schedule(static) private(jj,ji,zvar) 
    5160      DO ji = 1, jpi 
    5261         DO jj = 1, jpj 
    … …  
    5766      ! 
    5867      IF( nday_year == nyear_len(1) ) THEN 
    59          xksi   (:,:) = xksimax(:,:) 
    60          xksimax(:,:) = 0._wp 
     68!$OMP DO schedule(static) private(jj,ji) 
     69         DO jj = 1, jpj 
     70            DO ji = 1, jpi 
     71               xksi   (ji,jj) = xksimax(ji,jj) 
     72               xksimax(ji,jj) = 0._wp 
     73            END DO 
     74         END DO 
    6175      ENDIF 
     76!$OMP END PARALLEL 
    6277      ! 
    6378      IF( nn_timing == 1 )  CALL timing_stop('p4z_int') 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r7646 r7698  
    9797      IF( nn_timing == 1 )  CALL timing_start('p4z_lim') 
    9898      ! 
     99!$OMP PARALLEL 
     100!$OMP DO schedule(static) private(jk,jj,ji,zno3,zferlim,zconcd,zconcd2,zconcn,zconcn2,z1_trbphy,z1_trbdia) & 
     101!$OMP& private(zconc1d,zconc1dnh4,zconc0n,zconc0nnh4,zdenom,zlim1,zlim2,zlim3,zlim4,zratio,zironmin) 
    99102      DO jk = 1, jpkm1 
    100103         DO jj = 1, jpj 
    … …  
    173176         END DO 
    174177      END DO 
     178!$OMP END DO NOWAIT 
    175179 
    176180      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    177181      ! -------------------------------------------------------------------- 
     182!$OMP DO schedule(static) private(jk,jj,ji,zlim1,zlim2,zlim3,ztem1,ztem2,zetot1,zetot2) 
    178183      DO jk = 1, jpkm1 
    179184         DO jj = 1, jpj 
    … …  
    199204         END DO 
    200205      END DO 
    201       ! 
     206!$OMP END DO NOWAIT 
     207      ! 
     208!$OMP DO schedule(static) private(jk,jj,ji) 
    202209      DO jk = 1, jpkm1 
    203210         DO jj = 1, jpj 
    … …  
    210217         END DO 
    211218      END DO 
     219!$OMP END PARALLEL 
    212220      ! 
    213221      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 
    … …  
    241249         &                xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 
    242250      INTEGER :: ios                 ! Local integer output status for namelist read 
     251      INTEGER  ::   ji, jj, jk 
    243252 
    244253      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    … …  
    277286      ENDIF 
    278287      ! 
    279       nitrfac (:,:,:) = 0._wp 
     288!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     289      DO jk = 1, jpkm1 
     290         DO jj = 1, jpj 
     291            DO ji = 1, jpi 
     292               nitrfac (ji,jj,jk) = 0._wp 
     293            END DO 
     294         END DO 
     295      END DO 
    280296      ! 
    281297   END SUBROUTINE p4z_lim_init 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r7646 r7698  
    6969      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 
    7070      ! 
    71       zco3    (:,:,:) = 0. 
    72       zcaldiss(:,:,:) = 0. 
    73       zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
     71!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     72       DO jk = 1, jpk 
     73          DO jj = 1, jpj 
     74             DO ji = 1, jpi 
     75                zco3    (ji,jj,jk) = 0. 
     76                zcaldiss(ji,jj,jk) = 0. 
     77                zhinit(ji,jj,jk)   = hi(ji,jj,jk) * 1000. / ( rhop(ji,jj,jk) + rtrn ) 
     78             END DO 
     79          END DO 
     80      END DO 
    7481      !     ------------------------------------------- 
    7582      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    … …  
    7885      CALL solve_at_general(zhinit, zhi) 
    7986 
     87!$OMP PARALLEL 
     88!$OMP DO schedule(static) private(jk, jj, ji) 
    8089      DO jk = 1, jpkm1 
    8190         DO jj = 1, jpj 
    … …  
    94103      !     --------------------------------------------------------- 
    95104 
     105!$OMP DO schedule(static) private(jk,jj,ji,zcalcon,zfact,zomegaca,zexcess0,zexcess,zdispot) 
    96106      DO jk = 1, jpkm1 
    97107         DO jj = 1, jpj 
    … …  
    124134         END DO 
    125135      END DO 
     136!$OMP END PARALLEL 
    126137      ! 
    127138 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r7646 r7698  
    7979      ! 
    8080      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    81       zgrazing(:,:,:) = 0._wp 
    82  
     81!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     82      DO jk = 1, jpk 
     83         DO jj = 1, jpj 
     84            DO ji = 1, jpi 
     85               zgrazing(ji,jj,jk) = 0._wp 
     86            END DO 
     87         END DO 
     88      END DO 
     89 
     90!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompam,zfact,zrespz2,ztortz2,zcompadi,zcompaz,zcompaph,zfracal) & 
     91!$OMP& private(zcompapoc,zfood,zfoodlim,zdenom,zdenom2,zgraze2,zgrazd,zgrazz,zgrazn,zgrazpoc,zgraznf,zgrazf,zgrazpof) & 
     92!$OMP& private(zgrazffeg,zgrazfffg,zgrazffep,zgrazfffp,zgraztot,zproport,zratio,zratio2,zfrac,zfracfe,zgraztotf,zgrasrat) & 
     93!$OMP& private(zgraztotn,zgrasratn,zepshert,zepsherv,zgrarem2,zgrafer2,zgrapoc2,zgrarsig,zmortz2,zmortzgoc,zprcaca,zgrazcal) 
    8394      DO jk = 1, jpkm1 
    8495         DO jj = 1, jpj 
    … …  
    220231         CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    221232         IF( iom_use( "GRAZ2" ) ) THEN 
    222             zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton 
     233!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     234            DO jk = 1, jpk 
     235               DO jj = 1, jpj 
     236                  DO ji = 1, jpi 
     237                     zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk)  !   Total grazing of phyto by zooplankton 
     238                  END DO 
     239               END DO 
     240            END DO 
    223241            CALL iom_put( "GRAZ2", zw3d ) 
    224242         ENDIF 
    225243         IF( iom_use( "PCAL" ) ) THEN 
    226             zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production 
     244!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     245            DO jk = 1, jpk 
     246               DO jj = 1, jpj 
     247                  DO ji = 1, jpi 
     248                     zw3d(ji,jj,jk) = prodcal(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk)   !  Calcite production 
     249                  END DO 
     250               END DO 
     251            END DO 
    227252            CALL iom_put( "PCAL", zw3d )   
    228253         ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r7646 r7698  
    7979      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    8080      ! 
     81!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompaz,zfact,zrespz,ztortz,zcompadi,zcompaph,zcompapoc,zfood) & 
     82!$OMP& private(zfoodlim,zdenom,zdenom2,zgraze,zgrazp,zgrazm,zgrazsd,zgrazpf,zgrazmf,zgrazsf,zgraztot,zgraztotf) & 
     83!$OMP& private(zgraztotn,zgrasrat,zgrasratn,zepshert,zepsherv,zgrafer,zgrarem,zgrapoc,zgrarsig,zmortz,zprcaca) 
    8184      DO jk = 1, jpkm1 
    8285         DO jj = 1, jpj 
    … …  
    181184           CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    182185           IF( iom_use( "GRAZ1" ) ) THEN 
    183               zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
     186!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     187              DO jk = 1, jpk 
     188                 DO jj = 1, jpj 
     189                    DO ji = 1, jpi 
     190                       zw3d(ji,jj,jk) = zgrazing(ji,jj,jk) * 1.e+3 * rfact2r * tmask(ji,jj,jk)  !  Total grazing of phyto by zooplankton 
     191                    END DO 
     192                 END DO 
     193              END DO 
    184194              CALL iom_put( "GRAZ1", zw3d ) 
    185195           ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r7646 r7698  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    34    !! $Id$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    7474      IF( nn_timing == 1 )  CALL timing_start('p4z_nano') 
    7575      ! 
    76       prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
     76!$OMP PARALLEL 
     77!$OMP DO schedule(static) private(jk,jj,ji) 
     78      DO jk = 1, jpk 
     79         DO jj = 1, jpj 
     80            DO ji = 1, jpi 
     81               prodcal(ji,jj,jk) = 0.  !: calcite production variable set to zero 
     82            END DO 
     83         END DO 
     84      END DO 
     85!$OMP DO schedule(static) private(jk,jj,ji,zcompaph,zsizerat,zrespp,ztortp,zmortp,zfactfe,zfactch,zprcaca,zfracal) 
    7786      DO jk = 1, jpkm1 
    7887         DO jj = 1, jpj 
    … …  
    119128         END DO 
    120129      END DO 
     130!$OMP END PARALLEL 
    121131      ! 
    122132       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    153163      !     ------------------------------------------------------------ 
    154164 
     165!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zcompadi,zlim2,zlim1,zrespp2,ztortp2,zmortp2,zfactfe,zfactch,zfactsi) 
    155166      DO jk = 1, jpkm1 
    156167         DO jj = 1, jpj 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r7646 r7698  
    8484      !     Initialisation of variables used to compute PAR 
    8585      !     ----------------------------------------------- 
    86       ze1(:,:,:) = 0._wp 
    87       ze2(:,:,:) = 0._wp 
    88       ze3(:,:,:) = 0._wp 
     86!$OMP PARALLEL 
     87!$OMP DO schedule(static) private(jk,jj,ji) 
     88      DO jk = 1, jpk 
     89         DO jj = 1, jpj 
     90            DO ji = 1, jpi 
     91               ze1(ji,jj,jk) = 0._wp 
     92               ze2(ji,jj,jk) = 0._wp 
     93               ze3(ji,jj,jk) = 0._wp 
     94            END DO 
     95         END DO 
     96      END DO 
     97!$OMP END DO NOWAIT 
    8998      ! 
    9099      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    91100                                               !  -------------------------------------------------------- 
    92                     zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
    93       IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 
    94       ! 
     101!$OMP DO schedule(static) private(jk,jj,ji) 
     102      DO jk = 1, jpk 
     103         DO jj = 1, jpj 
     104            DO ji = 1, jpi 
     105               zchl3d(ji,jj,jk) = trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) 
     106            END DO 
     107         END DO 
     108      END DO 
     109!$OMP END PARALLEL 
     110      IF( ln_p5z ) THEN 
     111!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     112         DO jk = 1, jpk 
     113            DO jj = 1, jpj 
     114               DO ji = 1, jpi 
     115                  zchl3d(ji,jj,jk) = zchl3d(ji,jj,jk) + trb(ji,jj,jk,jppch) 
     116               END DO 
     117            END DO 
     118         END DO 
     119      END IF 
     120      ! 
     121!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,irgb) 
    95122      DO jk = 1, jpkm1    
    96123         DO jj = 1, jpj 
    … …  
    110137      IF( l_trcdm2dc ) THEN                     !  diurnal cycle 
    111138         ! 
    112          zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     139!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     140         DO jj = 1, jpj 
     141            DO ji = 1, jpi 
     142               zqsr_corr(ji,jj) = qsr_mean(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 
     143            END DO 
     144         END DO 
    113145         ! 
    114146         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 )  
    115147         ! 
     148!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    116149         DO jk = 1, nksrp       
    117             etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    118             enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    119             ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
     150            DO jj = 1, jpj 
     151               DO ji = 1, jpi 
     152                  etot_ndcy(ji,jj,jk) =        ze1(ji,jj,jk) +        ze2(ji,jj,jk) +       ze3(ji,jj,jk) 
     153                  enano    (ji,jj,jk) =  2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 
     154                  ediat    (ji,jj,jk) =  1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 
     155               END DO 
     156            END DO 
    120157         END DO 
    121158         IF( ln_p5z ) THEN 
     159!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    122160            DO jk = 1, nksrp       
    123               epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     161               DO jj = 1, jpj 
     162                  DO ji = 1, jpi 
     163                     epico  (ji,jj,jk) =  2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 
     164                  END DO 
     165               END DO 
    124166            END DO 
    125167         ENDIF 
    126168         ! 
    127          zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     169!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     170         DO jj = 1, jpj 
     171            DO ji = 1, jpi 
     172               zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 
     173            END DO 
     174         END DO 
    128175         ! 
    129176         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )  
    130177         ! 
     178!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    131179         DO jk = 1, nksrp       
    132             etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 
     180            DO jj = 1, jpj 
     181               DO ji = 1, jpi 
     182                  etot(ji,jj,jk) =  ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) 
     183               END DO 
     184            END DO 
    133185         END DO 
    134186         ! 
    135187      ELSE 
    136188         ! 
    137          zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     189!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     190         DO jj = 1, jpj 
     191            DO ji = 1, jpi 
     192               zqsr_corr(ji,jj) = qsr(ji,jj) / ( 1. - fr_i(ji,jj) + rtrn ) 
     193            END DO 
     194         END DO 
    138195         ! 
    139196         CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100  )  
    140197         ! 
    141          DO jk = 1, nksrp       
    142             etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
    143             enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
    144             ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
     198!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     199         DO jk = 1, nksrp 
     200            DO jj = 1, jpj 
     201               DO ji = 1, jpi 
     202                  etot (ji,jj,jk) =        ze1(ji,jj,jk) +        ze2(ji,jj,jk) +       ze3(ji,jj,jk) 
     203                  enano(ji,jj,jk) =  2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 
     204                  ediat(ji,jj,jk) =  1.6 * ze1(ji,jj,jk) + 0.69 * ze2(ji,jj,jk) + 0.7 * ze3(ji,jj,jk) 
     205               END DO 
     206            END DO 
    145207         END DO 
    146208         IF( ln_p5z ) THEN 
    147             DO jk = 1, nksrp       
    148               epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     209!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     210            DO jk = 1, nksrp 
     211               DO jj = 1, jpj 
     212                  DO ji = 1, jpi 
     213                     epico(ji,jj,jk) =  2.1 * ze1(ji,jj,jk) + 0.42 * ze2(ji,jj,jk) + 0.4 * ze3(ji,jj,jk) 
     214                  END DO 
     215               END DO 
    149216            END DO 
    150217         ENDIF 
    151          etot_ndcy(:,:,:) =  etot(:,:,:)  
     218!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     219         DO jk = 1, jpk 
     220            DO jj = 1, jpj 
     221               DO ji = 1, jpi 
     222                  etot_ndcy(ji,jj,jk) =  etot(ji,jj,jk) 
     223               END DO 
     224            END DO 
     225         END DO 
    152226      ENDIF 
    153227 
    … …  
    157231         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
    158232         ! 
    159          etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
     233!$OMP PARALLEL 
     234!$OMP DO schedule(static) private(jj,ji) 
     235         DO jj = 1, jpj 
     236            DO ji = 1, jpi 
     237               etot3(ji,jj,1) =  qsr(ji,jj) * tmask(ji,jj,1) 
     238            END DO 
     239         END DO 
     240!$OMP DO schedule(static) private(jk,jj,ji) 
    160241         DO jk = 2, nksrp + 1 
    161             etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 
    162          END DO 
     242            DO jj = 1, jpj 
     243               DO ji = 1, jpi 
     244                  etot3(ji,jj,jk) =  ( ze0(ji,jj,jk) + ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk) ) * tmask(ji,jj,jk) 
     245               END DO 
     246            END DO 
     247         END DO 
     248!$OMP END PARALLEL 
    163249         !                                     !  ------------------------ 
    164250      ENDIF 
    165251      !                                        !* Euphotic depth and level 
    166       neln   (:,:) = 1                            !  ------------------------ 
    167       heup   (:,:) = gdepw_n(:,:,2) 
    168       heup_01(:,:) = gdepw_n(:,:,2) 
     252                                               !  ------------------------ 
     253!$OMP PARALLEL  
     254!$OMP DO schedule(static) private(jj,ji) 
     255      DO jj = 1, jpj 
     256         DO ji = 1, jpi 
     257            neln(ji,jj) = 1 
     258            heup   (ji,jj) = gdepw_n(ji,jj,2) 
     259            heup_01(ji,jj) = gdepw_n(ji,jj,2) 
     260         END DO 
     261      END DO 
    169262 
    170263      DO jk = 2, nksrp 
     264!$OMP DO schedule(static) private(jj,ji) 
    171265         DO jj = 1, jpj 
    172266           DO ji = 1, jpi 
    … …  
    183277      END DO 
    184278      ! 
    185       heup   (:,:) = MIN( 300., heup   (:,:) ) 
    186       heup_01(:,:) = MIN( 300., heup_01(:,:) ) 
    187       !                                        !* mean light over the mixed layer 
    188       zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189       zetmp1 (:,:)   = 0.e0 
    190       zetmp2 (:,:)   = 0.e0 
    191       zetmp3 (:,:)   = 0.e0 
    192       zetmp4 (:,:)   = 0.e0 
     279!$OMP DO schedule(static) private(jj,ji) 
     280      DO jj = 1, jpj 
     281         DO ji = 1, jpi 
     282            heup   (ji,jj) = MIN( 300., heup   (ji,jj) ) 
     283            heup_01(ji,jj) = MIN( 300., heup_01(ji,jj) ) 
     284            !                                          !* mean light over the mixed layer 
     285            zdepmoy(ji,jj)   = 0.e0                    !  ------------------------------- 
     286            zetmp1 (ji,jj)   = 0.e0 
     287            zetmp2 (ji,jj)   = 0.e0 
     288            zetmp3 (ji,jj)   = 0.e0 
     289            zetmp4 (ji,jj)   = 0.e0 
     290        END DO 
     291      END DO 
    193292 
    194293      DO jk = 1, nksrp 
     294!$OMP DO schedule(static) private(jj,ji) 
    195295         DO jj = 1, jpj 
    196296            DO ji = 1, jpi 
    … …  
    206306      END DO 
    207307      ! 
    208       emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
    209       zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    210       ! 
     308!$OMP DO schedule(static) private(jk,jj,ji) 
     309      DO jk = 1, jpk 
     310         DO jj = 1, jpj 
     311            DO ji = 1, jpi 
     312               emoy(ji,jj,jk) = etot(ji,jj,jk)       ! remineralisation 
     313               zpar(ji,jj,jk) = etot_ndcy(ji,jj,jk)  ! diagnostic : PAR with no diurnal cycle  
     314            END DO 
     315         END DO 
     316      END DO 
     317      ! 
     318!$OMP DO schedule(static) private(jk,jj,ji,z1_dep) 
    211319      DO jk = 1, nksrp 
    212320         DO jj = 1, jpj 
    … …  
    222330         END DO 
    223331      END DO 
     332!$OMP END PARALLEL 
    224333      ! 
    225334      IF( ln_p5z ) THEN 
    226          zetmp5 (:,:) = 0.e0 
     335!$OMP PARALLEL 
     336!$OMP DO schedule(static) private(jj,ji) 
     337         DO jj = 1, jpj 
     338            DO ji = 1, jpi 
     339               zetmp5 (ji,jj) = 0.e0 
     340            END DO 
     341         END DO 
    227342         DO jk = 1, nksrp 
     343!$OMP DO schedule(static) private(jj,ji,z1_dep) 
    228344            DO jj = 1, jpj 
    229345               DO ji = 1, jpi 
    … …  
    236352            END DO 
    237353         END DO 
     354!$OMP END PARALLEL 
    238355      ENDIF 
    239356      IF( lk_iomput ) THEN 
    … …  
    274391 
    275392      !  Real shortwave 
    276       IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 
    277       ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:) 
     393      IF( ln_varpar ) THEN 
     394!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     395         DO jj = 1, jpj 
     396            DO ji = 1, jpi 
     397               zqsr(ji,jj) = par_varsw(ji,jj) * pqsr(ji,jj) 
     398            END DO 
     399         END DO 
     400      ELSE 
     401!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     402         DO jj = 1, jpj 
     403            DO ji = 1, jpi 
     404               zqsr(ji,jj) = xparsw         * pqsr(ji,jj) 
     405            END DO 
     406         END DO 
    278407      ENDIF 
    279408       
    280409      !  Light at the euphotic depth  
    281       IF( PRESENT( pqsr100 ) )  pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 
     410      IF( PRESENT( pqsr100 ) ) THEN 
     411!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     412         DO jj = 1, jpj 
     413            DO ji = 1, jpi 
     414               pqsr100(ji,jj) = 0.01 * 3. * zqsr(ji,jj) 
     415            END DO 
     416         END DO 
     417      ENDIF 
    282418 
    283419      IF( PRESENT( pe0 ) ) THEN     !  W-level 
    284420         ! 
    285          pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q 
    286          pe1(:,:,1) = zqsr(:,:)          
    287          pe2(:,:,1) = zqsr(:,:) 
    288          pe3(:,:,1) = zqsr(:,:) 
     421!$OMP PARALLEL 
     422!$OMP DO schedule(static) private(jj,ji) 
     423         DO jj = 1, jpj 
     424            DO ji = 1, jpi 
     425               pe0(ji,jj,1) = pqsr(ji,jj) - 3. * zqsr(ji,jj)    !   ( 1 - 3 * alpha ) * q 
     426               pe1(ji,jj,1) = zqsr(ji,jj) 
     427               pe2(ji,jj,1) = zqsr(ji,jj) 
     428               pe3(ji,jj,1) = zqsr(ji,jj) 
     429            END DO 
     430         END DO 
    289431         ! 
    290432         DO jk = 2, nksrp + 1 
     433!$OMP DO schedule(static) private(jj,ji) 
    291434            DO jj = 1, jpj 
    292435               DO ji = 1, jpi 
    … …  
    300443            ! 
    301444         END DO 
     445!$OMP END PARALLEL 
    302446        ! 
    303447      ELSE   ! T- level 
    304448        ! 
    305         pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 
    306         pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 
    307         pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
     449!$OMP PARALLEL 
     450!$OMP DO schedule(static) private(jj,ji) 
     451        DO jj = 1, jpj 
     452           DO ji = 1, jpi 
     453              pe1(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekb(ji,jj,1) ) 
     454              pe2(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekg(ji,jj,1) ) 
     455              pe3(ji,jj,1) = zqsr(ji,jj) * EXP( -0.5 * ekr(ji,jj,1) ) 
     456           END DO 
     457        END DO 
    308458        ! 
    309459        DO jk = 2, nksrp       
     460!$OMP DO schedule(static) private(jj,ji) 
    310461           DO jj = 1, jpj 
    311462              DO ji = 1, jpi 
    … …  
    316467           END DO 
    317468        END DO     
     469!$OMP END PARALLEL 
    318470        ! 
    319471      ENDIF 
    … …  
    369521      INTEGER :: ierr 
    370522      INTEGER :: ios                 ! Local integer output status for namelist read 
     523      INTEGER    ::   ji, jj, jk     ! dummy loop indices 
    371524      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
    372525      ! 
    … …  
    424577      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 
    425578      ! 
    426                          ekr      (:,:,:) = 0._wp 
    427                          ekb      (:,:,:) = 0._wp 
    428                          ekg      (:,:,:) = 0._wp 
    429                          etot     (:,:,:) = 0._wp 
    430                          etot_ndcy(:,:,:) = 0._wp 
    431                          enano    (:,:,:) = 0._wp 
    432                          ediat    (:,:,:) = 0._wp 
    433       IF( ln_p5z     )   epico    (:,:,:) = 0._wp 
    434       IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp 
     579!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     580         DO jk = 1, jpk 
     581            DO jj = 1, jpj 
     582               DO ji = 1, jpi 
     583                  ekr      (ji,jj,jk) = 0._wp 
     584                  ekb      (ji,jj,jk) = 0._wp 
     585                  ekg      (ji,jj,jk) = 0._wp 
     586                  etot     (ji,jj,jk) = 0._wp 
     587                  etot_ndcy(ji,jj,jk) = 0._wp 
     588                  enano    (ji,jj,jk) = 0._wp 
     589                  ediat    (ji,jj,jk) = 0._wp 
     590               END DO 
     591            END DO 
     592         END DO 
     593      IF( ln_qsr_bio ) THEN 
     594!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     595         DO jk = 1, jpk 
     596            DO jj = 1, jpj 
     597               DO ji = 1, jpi 
     598                  etot3    (ji,jj,jk) = 0._wp 
     599               END DO 
     600            END DO 
     601         END DO 
     602      END IF 
     603 
     604      IF( ln_p5z     ) THEN 
     605!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     606         DO jk = 1, jpk 
     607            DO jj = 1, jpj 
     608               DO ji = 1, jpi 
     609                  epico    (ji,jj,jk) = 0._wp 
     610               END DO 
     611            END DO 
     612         END DO 
     613      END IF 
    435614      !  
    436615      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init') 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90

    r7646 r7698  
    8989      ! Initialisation of temprary arrys 
    9090      IF( ln_p4z ) THEN 
    91          zremipoc(:,:,:) = xremip 
    92          zremigoc(:,:,:) = xremip 
     91!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     92         DO jk = 1, jpk 
     93            DO jj = 1, jpj 
     94               DO ji = 1, jpi 
     95                  zremipoc(ji,jj,jk) = xremip 
     96                  zremigoc(ji,jj,jk) = xremip 
     97               END DO 
     98            END DO 
     99         END DO 
    93100      ELSE    ! ln_p5z 
    94          zremipoc(:,:,:) = xremipc 
    95          zremigoc(:,:,:) = xremipc 
     101!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     102         DO jk = 1, jpk 
     103            DO jj = 1, jpj 
     104               DO ji = 1, jpi 
     105                  zremipoc(ji,jj,jk) = xremipc 
     106                  zremigoc(ji,jj,jk) = xremipc 
     107               END DO 
     108            END DO 
     109         END DO 
    96110      ENDIF 
    97       zorem3(:,:,:)   = 0. 
    98       orem  (:,:,:)   = 0. 
    99       ztremint(:,:,:) = 0. 
    100  
     111!$OMP PARALLEL 
     112!$OMP DO schedule(static) private(jk, jj, ji) 
     113      DO jk = 1, jpk 
     114         DO jj = 1, jpj 
     115            DO ji = 1, jpi 
     116               zorem3  (ji,jj,jk) = 0. 
     117               orem    (ji,jj,jk) = 0. 
     118               ztremint(ji,jj,jk) = 0. 
     119            END DO 
     120         END DO 
     121      END DO 
     122!OMP END DO NOWAIT 
    101123      DO jn = 1, jcpoc 
    102         alphag(:,:,:,jn) = alphan(jn) 
    103         alphap(:,:,:,jn) = alphan(jn) 
     124!$OMP DO schedule(static) private(jk, jj, ji) 
     125         DO jk = 1, jpk 
     126            DO jj = 1, jpj 
     127               DO ji = 1, jpi 
     128                  alphag(ji,jj,jk,jn) = alphan(jn) 
     129                  alphap(ji,jj,jk,jn) = alphan(jn) 
     130               END DO 
     131            END DO 
     132         END DO 
    104133      END DO 
     134!$OMP END PARALLEL 
    105135 
    106136     ! ----------------------------------------------------------------------- 
    … …  
    110140     ! ----------------------------------------------------------------------- 
    111141     DO jk = 2, jpkm1 
     142!$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn) 
    112143        DO jj = 1, jpj 
    113144           DO ji = 1, jpi 
    … …  
    120151                ! 
    121152                IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    122                   alphat = 0. 
    123                   remint = 0. 
    124                   ! 
    125153                  zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    126154                  zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    … …  
    155183                       &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
    156184                       &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
    157                        alphat = alphat + alphag(ji,jj,jk,jn) 
    158                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     185 
    159186                    END DO 
    160187                  ELSE 
    … …  
    174201                       &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
    175202                       &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn)  
    176                        alphat = alphat + alphag(ji,jj,jk,jn) 
    177                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    178203                    END DO 
    179204                  ENDIF 
     205                  ! 
     206                  alphat =  SUM(alphag(ji,jj,jk,:)) 
     207                  remint =  SUM(alphag(ji,jj,jk,:) * reminp(:)) 
    180208                  ! 
    181209                  DO jn = 1, jcpoc 
    … …  
    193221      END DO 
    194222 
    195       IF( ln_p4z ) THEN   ;  zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    196       ELSE                ;  zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
     223      IF( ln_p4z ) THEN    
     224!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     225         DO jk = 1, jpk 
     226            DO jj = 1, jpj 
     227               DO ji = 1, jpi 
     228                  zremigoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 
     229               END DO 
     230            END DO 
     231         END DO 
     232      ELSE 
     233!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     234         DO jk = 1, jpk 
     235            DO jj = 1, jpj 
     236               DO ji = 1, jpi 
     237                  zremigoc(ji,jj,jk) = MIN( xremipc, ztremint(ji,jj,jk) ) 
     238               END DO 
     239            END DO 
     240         END DO 
    197241      ENDIF 
    198242 
    199243      IF( ln_p4z ) THEN 
     244!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zorem2,zofer2,zofer3) 
    200245         DO jk = 1, jpkm1 
    201246            DO jj = 1, jpj 
    … …  
    221266         END DO 
    222267      ELSE 
     268!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremig,zopoc2,zofer2,zopon2,zopop2) 
    223269         DO jk = 1, jpkm1 
    224270            DO jj = 1, jpj 
    … …  
    266312     ! ------------------------------------------------------------------- 
    267313     ! 
    268      totprod(:,:) = 0. 
    269      totthick(:,:) = 0. 
    270      totcons(:,:) = 0. 
     314!$OMP PARALLEL 
     315!$OMP DO schedule(static) private(jj,ji) 
     316     DO jj = 1, jpj 
     317        DO ji = 1, jpi 
     318           totprod(ji,jj) = 0. 
     319           totthick(ji,jj) = 0. 
     320           totcons(ji,jj) = 0. 
     321        END DO 
     322     END DO 
    271323     ! intregrated production and consumption of POC in the mixed layer 
    272324     ! ---------------------------------------------------------------- 
    273325     !  
    274326     DO jk = 1, jpkm1 
     327!$OMP DO schedule(static) private(jj,ji,zdep) 
    275328        DO jj = 1, jpj 
    276329           DO ji = 1, jpi 
    … …  
    286339        END DO 
    287340     END DO 
     341!$OMP END PARALLEL 
    288342 
    289343     ! Computation of the lability spectrum in the mixed layer. In the mixed  
    290344     ! layer, this spectrum is supposed to be uniform. 
    291345     ! --------------------------------------------------------------------- 
     346!$OMP DO schedule(static) private(jk,jj,ji,zdep,alphat,remint,jn) 
    292347     DO jk = 1, jpkm1 
    293348        DO jj = 1, jpj 
    … …  
    295350              IF (tmask(ji,jj,jk) == 1.) THEN 
    296351                zdep = hmld(ji,jj) 
    297                 alphat = 0.0 
    298                 remint = 0.0 
    299352                IF( gdept_n(ji,jj,jk) <= zdep ) THEN 
    300353                   DO jn = 1, jcpoc 
    … …  
    303356                      alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
    304357                      &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
    305                       alphat = alphat + alphap(ji,jj,jk,jn) 
    306358                   END DO 
     359                   alphat =  SUM(alphap(ji,jj,jk,:)) 
    307360                   DO jn = 1, jcpoc 
    308361                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    309                       remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    310362                   END DO 
     363                   remint =  SUM(alphap(ji,jj,jk,:) * reminp(:)) 
    311364                   ! Mean remineralization rate in the mixed layer 
    312365                   ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    … …  
    317370     END DO 
    318371     ! 
    319      IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    320      ELSE                ;  zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
     372     IF( ln_p4z ) THEN   
     373!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     374        DO jk = 1, jpk 
     375           DO jj = 1, jpj 
     376              DO ji = 1, jpi 
     377                 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 
     378              END DO 
     379           END DO 
     380        END DO 
     381     ELSE                 
     382!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     383        DO jk = 1, jpk 
     384           DO jj = 1, jpj 
     385              DO ji = 1, jpi 
     386                 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 
     387              END DO 
     388           END DO 
     389        END DO 
    321390     ENDIF 
    322391 
    … …  
    330399     ! 
    331400     DO jk = 2, jpkm1 
     401!$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,alphat,remint,zsizek1,zsizek,zpoc,jn) 
    332402        DO jj = 1, jpj 
    333403           DO ji = 1, jpi 
    … …  
    335405                zdep = hmld(ji,jj) 
    336406                IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    337                   alphat = 0. 
    338                   remint = 0. 
    339407                  ! 
    340408                  ! the scale factors are corrected with temperature 
    … …  
    362430                       &   * zsizek ) ) 
    363431                       alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
    364                        alphat = alphat + alphap(ji,jj,jk,jn) 
    365432                    END DO 
    366433                  ELSE 
    … …  
    385452                       &   - exp( -reminp(jn) * zsizek ) ) 
    386453                       alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
    387                        alphat = alphat + alphap(ji,jj,jk,jn) 
    388454                    END DO 
    389455                  ENDIF 
     456                  alphat =  SUM(alphap(ji,jj,jk,:)) 
    390457                  ! Normalization of the lability spectrum so that the  
    391458                  ! integral is equal to 1 
    392459                  DO jn = 1, jcpoc 
    393460                     alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    394                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    395461                  END DO 
     462                  remint =  SUM(alphap(ji,jj,jk,:) * reminp(:)) 
    396463                  ! Mean remineralization rate in the water column 
    397464                  ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    … …  
    402469      END DO 
    403470 
    404      IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
    405      ELSE                ;  zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 
     471     IF( ln_p4z ) THEN   
     472!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     473        DO jk = 1, jpk 
     474           DO jj = 1, jpj 
     475              DO ji = 1, jpi 
     476                 zremipoc(ji,jj,jk) = MIN( xremip , ztremint(ji,jj,jk) ) 
     477              END DO 
     478           END DO 
     479        END DO 
     480     ELSE                 
     481!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     482        DO jk = 1, jpk 
     483           DO jj = 1, jpj 
     484              DO ji = 1, jpi 
     485                 zremipoc(ji,jj,jk) = MIN( xremipc , ztremint(ji,jj,jk) ) 
     486              END DO 
     487           END DO 
     488        END DO 
    406489     ENDIF 
    407490 
    408491     IF( ln_p4z ) THEN 
     492!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zorem,zofer) 
    409493         DO jk = 1, jpkm1 
    410494            DO jj = 1, jpj 
    … …  
    427511         END DO 
    428512     ELSE 
     513!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zremip,zopoc,zopon,zopop,zofer) 
    429514       DO jk = 1, jpkm1 
    430515          DO jj = 1, jpj 
    … …  
    487572      !! 
    488573      !!---------------------------------------------------------------------- 
    489       INTEGER :: jn 
     574      INTEGER :: jn, jk, jj, ji 
    490575      REAL(wp) :: remindelta, reminup, remindown 
    491576      INTEGER  :: ifault 
    … …  
    557642 
    558643      DO jn = 1, jcpoc 
    559          alphap(:,:,:,jn) = alphan(jn) 
     644!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     645         DO jk = 1, jpk 
     646            DO jj = 1, jpj 
     647               DO ji = 1, jpi 
     648                  alphap(ji,jj,jk,jn) = alphan(jn) 
     649               END DO 
     650            END DO 
     651         END DO 
    560652      END DO 
    561653 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r7646 r7698  
    9393      CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 
    9494      ! 
    95       zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
    96       zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp 
    97       zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
    98       zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
    99       zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp  
    100  
    101       ! Computation of the optimal production 
    102       prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)  
    103  
    10495      ! compute the day length depending on latitude and the day 
    10596      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
    10697      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
    10798 
     99!$OMP PARALLEL  
     100!$OMP DO schedule(static) private(jk,jj,ji) 
     101      DO jk = 1, jpk 
     102         DO jj = 1, jpj 
     103            DO ji = 1, jpi 
     104               zprorcan(ji,jj,jk) = 0._wp 
     105               zprorcad(ji,jj,jk) = 0._wp 
     106               zprofed (ji,jj,jk) = 0._wp 
     107               zprofen (ji,jj,jk) = 0._wp 
     108               zysopt  (ji,jj,jk) = 0._wp 
     109               zpronewn(ji,jj,jk) = 0._wp 
     110               zpronewd(ji,jj,jk) = 0._wp 
     111               zprdia  (ji,jj,jk) = 0._wp 
     112               zprbio  (ji,jj,jk) = 0._wp 
     113               zprdch  (ji,jj,jk) = 0._wp 
     114               zprnch  (ji,jj,jk) = 0._wp 
     115               zmxl_fac(ji,jj,jk) = 0._wp 
     116               zmxl_chl(ji,jj,jk) = 0._wp  
     117                
     118               ! Computation of the optimal production 
     119               prmax(ji,jj,jk) = 0.8_wp * r1_rday * tgfunc(ji,jj,jk) 
     120            END DO 
     121         END DO 
     122      END DO 
     123 
    108124      ! day length in hours 
    109       zstrn(:,:) = 0. 
     125!$OMP DO schedule(static) private(jj,ji) 
     126      DO jj = 1, jpj 
     127         DO ji = 1, jpi 
     128            zstrn(ji,jj) = 0. 
     129         END DO 
     130      END DO 
     131!$OMP DO schedule(static) private(jj,ji,zargu) 
    110132      DO jj = 1, jpj 
    111133         DO ji = 1, jpi 
    … …  
    117139 
    118140      ! Impact of the day duration and light intermittency on phytoplankton growth 
     141!$OMP DO schedule(static) private(jk,jj,ji,zval) 
    119142      DO jk = 1, jpkm1 
    120143         DO jj = 1 ,jpj 
    … …  
    132155      END DO 
    133156 
    134       zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 
    135       zprdia(:,:,:) = zprbio(:,:,:) 
     157!$OMP DO schedule(static) private(jk,jj,ji) 
     158      DO jk = 1, jpk 
     159         DO jj = 1 ,jpj 
     160            DO ji = 1, jpi 
     161               zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zmxl_fac(ji,jj,jk) 
     162               zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     163            END DO 
     164         END DO 
     165      END DO 
    136166 
    137167      ! Maximum light intensity 
    138       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     168!$OMP DO schedule(static) private(jj,ji) 
     169      DO jj = 1 ,jpj 
     170         DO ji = 1, jpi 
     171            IF( zstrn(ji,jj) < 1.e0 ) zstrn(ji,jj) = 24. 
     172         END DO 
     173      END DO 
    139174 
    140175      ! Computation of the P-I slope for nanos and diatoms 
     176!$OMP DO schedule(static) private(jk,jj,ji,ztn,zadap,zconctemp,zconctemp2) 
    141177      DO jk = 1, jpkm1 
    142178         DO jj = 1, jpj 
    … …  
    159195 
    160196      IF( ln_newprod ) THEN 
     197!$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped) 
    161198         DO jk = 1, jpkm1 
    162199            DO jj = 1, jpj 
    … …  
    182219         END DO 
    183220      ELSE 
     221!$OMP DO schedule(static) private(jk,jj,ji,zpislopen,zpisloped) 
    184222         DO jk = 1, jpkm1 
    185223            DO jj = 1, jpj 
    … …  
    206244      !  Computation of a proxy of the N/C ratio 
    207245      !  --------------------------------------- 
     246!$OMP DO schedule(static) private(jk,jj,ji,zval) 
    208247      DO jk = 1, jpkm1 
    209248         DO jj = 1, jpj 
    … …  
    218257         END DO 
    219258      END DO 
    220  
    221  
     259!$OMP END DO NOWAIT 
     260 
     261 
     262!$OMP DO schedule(static) private(jk,jj,ji,zlim,zsilim,zsilfac,zsiborn,zsilfac2) 
    222263      DO jk = 1, jpkm1 
    223264         DO jj = 1, jpj 
    … …  
    244285         END DO 
    245286      END DO 
     287!$OMP END DO NOWAIT 
    246288 
    247289      !  Mixed-layer effect on production  
    248290      !  Sea-ice effect on production 
    249291 
     292!$OMP DO schedule(static) private(jk,jj,ji) 
    250293      DO jk = 1, jpkm1 
    251294         DO jj = 1, jpj 
    … …  
    260303 
    261304      ! Computation of the various production terms  
     305!$OMP DO schedule(static) private(jk,jj,ji,zratio,zmax) 
    262306      DO jk = 1, jpkm1 
    263307         DO jj = 1, jpj 
    … …  
    290334 
    291335      ! Computation of the chlorophyll production terms 
     336!$OMP DO schedule(static) private(jk,jj,ji,znanotot,zprod,zprochln,chlcnm_n,zprochld,zdiattot) 
    292337      DO jk = 1, jpkm1 
    293338         DO jj = 1, jpj 
    … …  
    317362 
    318363      !   Update the arrays TRA which contain the biological sources and sinks 
     364!$OMP DO schedule(static) private(jk,jj,ji,zproreg,zproreg2,zdocprod,zfeup) 
    319365      DO jk = 1, jpkm1 
    320366         DO jj = 1, jpj 
    … …  
    348394     ! 
    349395     IF( ln_ligand ) THEN 
     396!$OMP DO schedule(static) private(jk,jj,ji,zdocprod,zfeup) 
    350397         DO jk = 1, jpkm1 
    351398            DO jj = 1, jpj 
    … …  
    360407        END DO 
    361408     ENDIF 
     409!$OMP END PARALLEL 
    362410 
    363411 
    … …  
    373421          ! 
    374422          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN 
    375               zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
    376               CALL iom_put( "PPPHYN"  , zw3d ) 
     423!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     424             DO jk = 1, jpk 
     425                DO jj = 1, jpj 
     426                   DO ji = 1, jpi 
     427                      zw3d(ji,jj,jk) = zprorcan (ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! primary production by nanophyto 
     428                   END DO 
     429                END DO 
     430             END DO 
     431             CALL iom_put( "PPPHYN"  , zw3d ) 
     432             ! 
     433!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     434             DO jk = 1, jpk 
     435                DO jj = 1, jpj 
     436                   DO ji = 1, jpi 
     437                      zw3d(ji,jj,jk) = zprorcad (ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! primary production by nanophyto 
     438                   END DO 
     439                END DO 
     440             END DO 
     441             CALL iom_put( "PPPHYD"  , zw3d ) 
     442          ENDIF 
     443          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN 
     444!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     445             DO jk = 1, jpk 
     446                DO jj = 1, jpj 
     447                   DO ji = 1, jpi 
     448                      zw3d(ji,jj,jk) = zpronewn (ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! new primary production by nanophyto 
     449                   END DO 
     450                END DO 
     451             END DO 
     452             CALL iom_put( "PPNEWN"  , zw3d ) 
    377453              ! 
    378               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes 
    379               CALL iom_put( "PPPHYD"  , zw3d ) 
    380           ENDIF 
    381           IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN 
    382               zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
    383               CALL iom_put( "PPNEWN"  , zw3d ) 
    384               ! 
    385               zw3d(:,:,:) = zpronewd(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by diatomes 
    386               CALL iom_put( "PPNEWD"  , zw3d ) 
     454!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     455             DO jk = 1, jpk 
     456                DO jj = 1, jpj 
     457                   DO ji = 1, jpi 
     458                      zw3d(ji,jj,jk) = zpronewd (ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! new primary production by nanophyto 
     459                   END DO 
     460                END DO 
     461             END DO 
     462             CALL iom_put( "PPNEWD"  , zw3d ) 
    387463          ENDIF 
    388464          IF( iom_use( "PBSi" ) )  THEN 
    389               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ! biogenic silica production 
    390               CALL iom_put( "PBSi"  , zw3d ) 
     465!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     466             DO jk = 1, jpk 
     467                DO jj = 1, jpj 
     468                   DO ji = 1, jpi 
     469                      zw3d(ji,jj,jk) = zprorcad(ji,jj,jk) * zfact * tmask(ji,jj,jk) * zysopt(ji,jj,jk) ! biogenic silica production 
     470                   END DO 
     471                END DO 
     472             END DO 
     473             CALL iom_put( "PBSi"  , zw3d ) 
    391474          ENDIF 
    392475          IF( iom_use( "PFeN" ) .OR. iom_use( "PFeD" ) )  THEN 
    393               zw3d(:,:,:) = zprofen(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by nanophyto 
    394               CALL iom_put( "PFeN"  , zw3d ) 
    395               ! 
    396               zw3d(:,:,:) = zprofed(:,:,:) * zfact * tmask(:,:,:)  ! biogenic iron production by  diatomes 
    397               CALL iom_put( "PFeD"  , zw3d ) 
     476!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     477             DO jk = 1, jpk 
     478                DO jj = 1, jpj 
     479                   DO ji = 1, jpi 
     480                      zw3d(ji,jj,jk) = zprofen(ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! biogenic iron production by nanophyto 
     481                   END DO 
     482                END DO 
     483             END DO 
     484             CALL iom_put( "PFeN"  , zw3d ) 
     485             ! 
     486!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     487             DO jk = 1, jpk 
     488                DO jj = 1, jpj 
     489                   DO ji = 1, jpi 
     490                      zw3d(ji,jj,jk) = zprofed(ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! biogenic iron production by nanophyto 
     491                   END DO 
     492                END DO 
     493             END DO 
     494             CALL iom_put( "PFeD"  , zw3d ) 
    398495          ENDIF 
    399496          IF( iom_use( "Mumax" ) )  THEN 
    400               zw3d(:,:,:) = prmax(:,:,:) * tmask(:,:,:)   ! Maximum growth rate 
    401               CALL iom_put( "Mumax"  , zw3d ) 
     497!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     498             DO jk = 1, jpk 
     499                DO jj = 1, jpj 
     500                   DO ji = 1, jpi 
     501                      zw3d(ji,jj,jk) = prmax(ji,jj,jk) * tmask(ji,jj,jk)   ! Maximum growth rate 
     502                   END DO 
     503                END DO 
     504             END DO 
     505             CALL iom_put( "Mumax"  , zw3d ) 
    402506          ENDIF 
    403507          IF( iom_use( "MuN" ) .OR. iom_use( "MuD" ) )  THEN 
    404               zw3d(:,:,:) = zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:)  ! Realized growth rate for nanophyto 
    405               CALL iom_put( "MuN"  , zw3d ) 
    406               ! 
    407               zw3d(:,:,:) =  zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:)  ! Realized growth rate for diatoms 
    408               CALL iom_put( "MuD"  , zw3d ) 
     508!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     509             DO jk = 1, jpk 
     510                DO jj = 1, jpj 
     511                   DO ji = 1, jpi 
     512                      zw3d(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tmask(ji,jj,jk)  ! Realized growth rate for nanophyto 
     513                   END DO 
     514                END DO 
     515             END DO 
     516             CALL iom_put( "MuN"  , zw3d ) 
     517             ! 
     518!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     519             DO jk = 1, jpk 
     520                DO jj = 1, jpj 
     521                   DO ji = 1, jpi 
     522                      zw3d(ji,jj,jk) =  zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tmask(ji,jj,jk)  ! Realized growth rate for diatoms 
     523                   END DO 
     524                END DO 
     525             END DO 
     526             CALL iom_put( "MuD"  , zw3d ) 
    409527          ENDIF 
    410528          IF( iom_use( "LNlight" ) .OR. iom_use( "LDlight" ) )  THEN 
    411               zw3d(:,:,:) = zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ! light limitation term 
    412               CALL iom_put( "LNlight"  , zw3d ) 
    413               ! 
    414               zw3d(:,:,:) =  zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:)  ! light limitation term 
    415               CALL iom_put( "LDlight"  , zw3d ) 
     529!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     530             DO jk = 1, jpk 
     531                DO jj = 1, jpj 
     532                   DO ji = 1, jpi 
     533                      zw3d(ji,jj,jk) = zprbio (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk) ! light limitation term 
     534                   END DO 
     535                END DO 
     536             END DO 
     537             CALL iom_put( "LNlight"  , zw3d ) 
     538             ! 
     539!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     540             DO jk = 1, jpk 
     541                DO jj = 1, jpj 
     542                   DO ji = 1, jpi 
     543                      zw3d(ji,jj,jk) =  zprdia (ji,jj,jk) / (prmax(ji,jj,jk) + rtrn) * tmask(ji,jj,jk)  ! light limitation term 
     544                   END DO 
     545                END DO 
     546             END DO 
     547             CALL iom_put( "LDlight"  , zw3d ) 
    416548          ENDIF 
    417549          IF( iom_use( "TPP" ) )  THEN 
    418               zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
    419               CALL iom_put( "TPP"  , zw3d ) 
     550!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     551             DO jk = 1, jpk 
     552                DO jj = 1, jpj 
     553                   DO ji = 1, jpi 
     554                      zw3d(ji,jj,jk) = ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * zfact * tmask(ji,jj,jk)  ! total primary production 
     555                   END DO 
     556                END DO 
     557             END DO 
     558             CALL iom_put( "TPP"  , zw3d ) 
    420559          ENDIF 
    421560          IF( iom_use( "TPNEW" ) )  THEN 
    422               zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
    423               CALL iom_put( "TPNEW"  , zw3d ) 
     561!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     562             DO jk = 1, jpk 
     563                DO jj = 1, jpj 
     564                   DO ji = 1, jpi 
     565                      zw3d(ji,jj,jk) = ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * zfact * tmask(ji,jj,jk)  ! total new production 
     566                   END DO 
     567                END DO 
     568             END DO 
     569             CALL iom_put( "TPNEW"  , zw3d ) 
    424570          ENDIF 
    425571          IF( iom_use( "TPBFE" ) )  THEN 
    426               zw3d(:,:,:) = ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  ! total biogenic iron production 
    427               CALL iom_put( "TPBFE"  , zw3d ) 
     572!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     573             DO jk = 1, jpk 
     574                DO jj = 1, jpj 
     575                   DO ji = 1, jpi 
     576                      zw3d(ji,jj,jk) = ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * zfact * tmask(ji,jj,jk)  ! total biogenic iron production 
     577                   END DO 
     578                END DO 
     579             END DO 
     580             CALL iom_put( "TPBFE"  , zw3d ) 
    428581          ENDIF 
    429582          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN   
    430              zw2d(:,:) = 0. 
     583!$OMP PARALLEL 
     584!$OMP DO schedule(static) private(jj,ji) 
     585             DO jj = 1, jpj 
     586                DO ji =1 ,jpi 
     587                   zw2d(ji,jj) = 0. 
     588                END DO 
     589             END DO 
    431590             DO jk = 1, jpkm1 
    432                zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     591!$OMP DO schedule(static) private(jj,ji) 
     592                DO jj = 1, jpj 
     593                   DO ji =1 ,jpi 
     594                      zw2d(ji,jj) = zw2d(ji,jj) + zprorcan (ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! vert. integrated  primary produc. by nano 
     595                   END DO 
     596                END DO 
    433597             ENDDO 
     598!$OMP END PARALLEL 
    434599             CALL iom_put( "INTPPPHYN" , zw2d ) 
    435600             ! 
    436              zw2d(:,:) = 0. 
     601!$OMP PARALLEL 
     602!$OMP DO schedule(static) private(jj,ji) 
     603             DO jj = 1, jpj 
     604                DO ji =1 ,jpi 
     605                   zw2d(ji,jj) = 0. 
     606                END DO 
     607             END DO 
    437608             DO jk = 1, jpkm1 
    438                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
     609!$OMP DO schedule(static) private(jj,ji) 
     610                DO jj = 1, jpj 
     611                   DO ji =1 ,jpi 
     612                      zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated  primary produc. by diatom 
     613                   END DO 
     614                END DO 
    439615             ENDDO 
     616!$OMP END PARALLEL 
    440617             CALL iom_put( "INTPPPHYD" , zw2d ) 
    441618          ENDIF 
    442619          IF( iom_use( "INTPP" ) ) THEN    
    443              zw2d(:,:) = 0. 
     620!$OMP PARALLEL 
     621!$OMP DO schedule(static) private(jj,ji) 
     622             DO jj = 1, jpj 
     623                DO ji =1 ,jpi 
     624                   zw2d(ji,jj) = 0. 
     625                END DO 
     626             END DO 
    444627             DO jk = 1, jpkm1 
    445                 zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     628!$OMP DO schedule(static) private(jj,ji) 
     629                DO jj = 1, jpj 
     630                   DO ji =1 ,jpi 
     631                      zw2d(ji,jj) = zw2d(ji,jj) + ( zprorcan(ji,jj,jk) + zprorcad(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert. integrated pp 
     632                   END DO 
     633                END DO 
    446634             ENDDO 
     635!$OMP END PARALLEL 
    447636             CALL iom_put( "INTPP" , zw2d ) 
    448637          ENDIF 
    449638          IF( iom_use( "INTPNEW" ) ) THEN     
    450              zw2d(:,:) = 0. 
     639!$OMP PARALLEL 
     640!$OMP DO schedule(static) private(jj,ji) 
     641             DO jj = 1, jpj 
     642                DO ji =1 ,jpi 
     643                   zw2d(ji,jj) = 0. 
     644                END DO 
     645             END DO 
    451646             DO jk = 1, jpkm1 
    452                 zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     647!$OMP DO schedule(static) private(jj,ji) 
     648                DO jj = 1, jpj 
     649                   DO ji =1 ,jpi 
     650                      zw2d(ji,jj) = zw2d(ji,jj) + ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! vert. integrated new prod 
     651                   END DO 
     652                END DO 
    453653             ENDDO 
     654!$OMP END PARALLEL 
    454655             CALL iom_put( "INTPNEW" , zw2d ) 
    455656          ENDIF 
    456657          IF( iom_use( "INTPBFE" ) ) THEN           !   total biogenic iron production  ( vertically integrated ) 
    457              zw2d(:,:) = 0. 
     658!$OMP PARALLEL 
     659!$OMP DO schedule(static) private(jj,ji) 
     660             DO jj = 1, jpj 
     661                DO ji =1 ,jpi 
     662                   zw2d(ji,jj) = 0. 
     663                END DO 
     664             END DO 
    458665             DO jk = 1, jpkm1 
    459                 zw2d(:,:) = zw2d(:,:) + ( zprofen(:,:,jk) + zprofed(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert integr. bfe prod 
     666!$OMP DO schedule(static) private(jj,ji) 
     667                DO jj = 1, jpj 
     668                   DO ji =1 ,jpi 
     669                      zw2d(ji,jj) = zw2d(ji,jj) + ( zprofen(ji,jj,jk) + zprofed(ji,jj,jk) ) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! vert integr. bfe prod 
     670                   END DO 
     671                END DO 
    460672             ENDDO 
     673!$OMP END PARALLEL 
    461674            CALL iom_put( "INTPBFE" , zw2d ) 
    462675          ENDIF 
    463676          IF( iom_use( "INTPBSI" ) ) THEN           !   total biogenic silica production  ( vertically integrated ) 
    464              zw2d(:,:) = 0. 
     677!$OMP PARALLEL 
     678!$OMP DO schedule(static) private(jj,ji) 
     679             DO jj = 1, jpj 
     680                DO ji =1 ,jpi 
     681                   zw2d(ji,jj) = 0. 
     682                END DO 
     683             END DO 
    465684             DO jk = 1, jpkm1 
    466                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * zysopt(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert integr. bsi prod 
     685!$OMP DO schedule(static) private(jj,ji) 
     686                DO jj = 1, jpj 
     687                   DO ji =1 ,jpi 
     688                      zw2d(ji,jj) = zw2d(ji,jj) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * e3t_n(ji,jj,jk) * zfact * tmask(ji,jj,jk)  ! vert integr. bsi prod 
     689                   END DO 
     690                END DO 
    467691             ENDDO 
     692!$OMP END PARALLEL 
    468693             CALL iom_put( "INTPBSI" , zw2d ) 
    469694          ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r7646 r7698  
    7878 
    7979      ! Initialisation of temprary arrys 
    80       zdepprod(:,:,:) = 1._wp 
    81       ztempbac(:,:)   = 0._wp 
    82       zfacsib(:,:,:)  = xsilab / ( 1.0 - xsilab ) 
    83       zfacsi(:,:,:)   = xsilab 
     80!$OMP PARALLEL 
     81!$OMP DO schedule(static) private(jk,jj,ji) 
     82      DO jk = 1, jpk 
     83         DO jj = 1, jpj 
     84            DO ji = 1, jpi 
     85               zdepprod(ji,jj,jk) = 1._wp 
     86               zfacsib(ji,jj,jk)  = xsilab / ( 1.0 - xsilab ) 
     87               zfacsi(ji,jj,jk)   = xsilab 
     88            END DO 
     89         END DO 
     90      END DO 
     91!$OMP DO schedule(static) private(jj,ji) 
     92      DO jj = 1, jpj 
     93         DO ji = 1, jpi 
     94            ztempbac(ji,jj)   = 0._wp 
     95         END DO 
     96      END DO 
    8497 
    8598      ! Computation of the mean phytoplankton concentration as 
    … …  
    89102      ! ------------------------------------------------------- 
    90103      DO jk = 1, jpkm1 
     104!$OMP DO schedule(static) private(jj,ji,zdep,zdepmin) 
    91105         DO jj = 1, jpj 
    92106            DO ji = 1, jpi 
    … …  
    105119 
    106120      IF( ln_p4z ) THEN 
     121!$OMP DO schedule(static) private(jk,jj,ji,zremik,zolimit) 
    107122         DO jk = 1, jpkm1 
    108123            DO jj = 1, jpj 
    … …  
    136151         END DO 
    137152      ELSE 
     153!$OMP DO schedule(static) private(jk,jj,ji,zremik,zremikc,zremikn,zremikp,zolimit,zolimic,zolimin,zolimip,zdenitrn,zdenitrp) 
    138154         DO jk = 1, jpkm1 
    139155            DO jj = 1, jpj 
    … …  
    181197 
    182198 
     199!$OMP DO schedule(static) private(jk,jj,ji,zonitr,zdenitnh4) 
    183200      DO jk = 1, jpkm1 
    184201         DO jj = 1, jpj 
    … …  
    199216         END DO 
    200217      END DO 
    201  
    202        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    203          WRITE(charout, FMT="('rem1')") 
    204          CALL prt_ctl_trc_info(charout) 
    205          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    206        ENDIF 
    207  
     218!$OMP END PARALLEL 
     219 
     220      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     221        WRITE(charout, FMT="('rem1')") 
     222        CALL prt_ctl_trc_info(charout) 
     223        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     224      ENDIF 
     225 
     226!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zbactfer) 
    208227      DO jk = 1, jpkm1 
    209228         DO jj = 1, jpj 
    … …  
    224243      END DO 
    225244 
    226        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    227          WRITE(charout, FMT="('rem2')") 
    228          CALL prt_ctl_trc_info(charout) 
    229          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    230        ENDIF 
     245      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     246        WRITE(charout, FMT="('rem2')") 
     247        CALL prt_ctl_trc_info(charout) 
     248        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     249      ENDIF 
    231250 
    232251      ! Initialization of the array which contains the labile fraction 
    … …  
    235254 
    236255      DO jk = 1, jpkm1 
     256!$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,zsatur,zsatur2,znusil,zsiremin,zosil) 
    237257         DO jj = 1, jpj 
    238258            DO ji = 1, jpi 
    … …  
    264284         CALL prt_ctl_trc_info(charout) 
    265285         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    266        ENDIF 
     286      ENDIF 
    267287 
    268288      IF( knt == nrdttrc ) THEN 
    269           CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    270           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    271           ! 
    272           IF( iom_use( "REMIN" ) )  THEN 
    273               zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate 
    274               CALL iom_put( "REMIN"  , zw3d ) 
    275           ENDIF 
    276           IF( iom_use( "DENIT" ) )  THEN 
    277               zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification 
    278               CALL iom_put( "DENIT"  , zw3d ) 
    279           ENDIF 
    280           ! 
    281           CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    282        ENDIF 
     289         CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
     290         zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
     291         ! 
     292         IF( iom_use( "REMIN" ) )  THEN 
     293!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     294            DO jk = 1, jpk 
     295               DO jj = 1, jpj 
     296                  DO ji = 1, jpi 
     297                     zw3d(ji,jj,jk) = zolimi(ji,jj,jk) * tmask(ji,jj,jk) * zfact !  Remineralisation rate 
     298                  END DO 
     299               END DO 
     300            END DO 
     301            CALL iom_put( "REMIN"  , zw3d ) 
     302         ENDIF 
     303         IF( iom_use( "DENIT" ) )  THEN 
     304!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     305            DO jk = 1, jpk 
     306               DO jj = 1, jpj 
     307                  DO ji = 1, jpi 
     308                     zw3d(ji,jj,jk) = denitr(ji,jj,jk) * rdenit * rno3 * tmask(ji,jj,jk) * zfact ! Denitrification 
     309                  END DO 
     310               END DO 
     311            END DO 
     312            CALL iom_put( "DENIT"  , zw3d ) 
     313         ENDIF 
     314         ! 
     315         CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
     316      ENDIF 
    283317      ! 
    284318      CALL wrk_dealloc( jpi, jpj,      ztempbac                  ) 
    … …  
    305339         &                xremikc, xremikn, xremikp 
    306340      INTEGER :: ios                 ! Local integer output status for namelist read 
     341      INTEGER :: ji, jj, jk 
    307342 
    308343      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    … …  
    334369      ENDIF 
    335370      ! 
    336       denitr  (:,:,:) = 0._wp 
     371!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     372      DO jk = 1, jpk 
     373         DO jj = 1, jpj 
     374            DO ji = 1, jpi 
     375               denitr  (ji,jj,jk) = 0._wp 
     376            END DO 
     377         END DO 
     378      END DO 
    337379      ! 
    338380   END SUBROUTINE p4z_rem_init 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r7646 r7698  
    116116            CALL fld_read( kt, 1, sf_dust ) 
    117117            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 
    118                dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     118!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     119               DO jj = 1, jpj 
     120                  DO ji = 1, jpi 
     121                     dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) 
     122                  END DO 
     123               END DO 
    119124            ELSE 
    120                dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 
     125!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     126               DO jj = 1, jpj 
     127                  DO ji = 1, jpi 
     128                     dust(ji,jj) = sf_dust(1)%fnow(ji,jj,1) * ( 1.0 - fr_i(ji,jj) ) 
     129                  END DO 
     130               END DO 
    121131            ENDIF 
    122132         ENDIF 
    … …  
    126136         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN 
    127137            CALL fld_read( kt, 1, sf_solub ) 
    128             solub(:,:) = sf_solub(1)%fnow(:,:,1) 
     138!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     139            DO jj = 1, jpj 
     140               DO ji = 1, jpi 
     141                  solub(ji,jj) = sf_solub(1)%fnow(ji,jj,1) 
     142               END DO 
     143            END DO 
    129144         ENDIF 
    130145      ENDIF 
    … …  
    137152            CALL fld_read( kt, 1, sf_river ) 
    138153            IF( ln_p4z ) THEN 
     154!$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef) 
    139155               DO jj = 1, jpj 
    140156                  DO ji = 1, jpi 
    … …  
    153169               END DO 
    154170            ELSE    !  ln_p5z 
     171!$OMP PARALLEL DO schedule(static) private(jj, ji, zcoef) 
    155172               DO jj = 1, jpj 
    156173                  DO ji = 1, jpi 
    … …  
    179196      IF( ln_ndepo ) THEN 
    180197         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
    181              zcoef = rno3 * 14E6 * ryyss 
    182              CALL fld_read( kt, 1, sf_ndepo ) 
    183              nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)  
     198            zcoef = rno3 * 14E6 * ryyss 
     199            CALL fld_read( kt, 1, sf_ndepo ) 
     200!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     201            DO jj = 1, jpj 
     202               DO ji = 1, jpi 
     203                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 
     204               END DO 
     205            END DO 
    184206         ENDIF 
    185207         IF( .NOT.ln_linssh ) THEN 
    186            zcoef = rno3 * 14E6 * ryyss 
    187            nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1)  
     208            zcoef = rno3 * 14E6 * ryyss 
     209!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     210            DO jj = 1, jpj 
     211               DO ji = 1, jpi 
     212                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / zcoef / e3t_n(ji,jj,1) 
     213               END DO 
     214            END DO 
    188215         ENDIF 
    189216      ENDIF 
    … …  
    292319      ! online configuration : computed in sbcrnf 
    293320      IF( l_offline ) THEN 
    294         nk_rnf(:,:) = 1 
    295         h_rnf (:,:) = gdept_n(:,:,1) 
     321!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     322         DO jj = 1, jpj 
     323            DO ji = 1, jpi 
     324               nk_rnf(ji,jj) = 1 
     325               h_rnf (ji,jj) = gdept_n(ji,jj,1) 
     326            END DO 
     327         END DO 
    296328      ENDIF 
    297329 
    … …  
    466498         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
    467499         IF (lwp) WRITE(numout,*) 
     500!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmaskt) 
    468501         DO jk = 1, ik50 
    469502            DO jj = 2, jpjm1 
    … …  
    480513         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    481514         ! 
     515!$OMP PARALLEL 
     516!$OMP DO schedule(static) private(jk, jj, ji, zexpide, zdenitide) 
    482517         DO jk = 1, jpk 
    483518            DO jj = 1, jpj 
    … …  
    489524            END DO 
    490525         END DO 
     526!$OMP END DO NOWAIT 
    491527         ! Coastal supply of iron 
    492528         ! ------------------------- 
    493          ironsed(:,:,jpk) = 0._wp 
     529!$OMP DO schedule(static) private(jj,ji) 
     530         DO jj = 1, jpj 
     531            DO ji = 1, jpi 
     532               ironsed(ji,jj,jpk) = 0._wp 
     533            END DO 
     534         END DO 
     535!$OMP DO schedule(static) private(jk,jj,ji) 
    494536         DO jk = 1, jpkm1 
    495             ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 
    496          END DO 
     537            DO jj = 1, jpj 
     538               DO ji = 1, jpi 
     539                  ironsed(ji,jj,jk) = sedfeinput * zcmask(ji,jj,jk) / ( e3t_0(ji,jj,jk) * rday ) 
     540               END DO 
     541            END DO 
     542         END DO 
     543!$OMP END PARALLEL 
    497544         DEALLOCATE( zcmask) 
    498545      ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r7646 r7698  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    34    !! $Id$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    8484 
    8585 
    86       zdenit2d(:,:) = 0.e0 
    87       zbureff (:,:) = 0.e0 
    88       zwork1  (:,:) = 0.e0 
    89       zwork2  (:,:) = 0.e0 
    90       zwork3  (:,:) = 0.e0 
    91       zsedsi  (:,:) = 0.e0 
    92       zsedcal (:,:) = 0.e0 
    93       zsedc   (:,:) = 0.e0 
    94  
     86!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     87      DO jj = 1, jpj 
     88         DO ji = 1, jpi 
     89            zdenit2d(ji,jj) = 0.e0 
     90            zbureff (ji,jj) = 0.e0 
     91            zwork1  (ji,jj) = 0.e0 
     92            zwork2  (ji,jj) = 0.e0 
     93            zwork3  (ji,jj) = 0.e0 
     94            zsedsi  (ji,jj) = 0.e0 
     95            zsedcal (ji,jj) = 0.e0 
     96            zsedc   (ji,jj) = 0.e0 
     97         END DO 
     98      END DO 
    9599 
    96100      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    … …  
    100104         CALL wrk_alloc( jpi, jpj, zironice ) 
    101105         !                                               
     106!$OMP PARALLEL  
     107!$OMP DO schedule(static) private(jj,ji,zdep,zwflux,zfminus,zfplus) 
    102108         DO jj = 1, jpj 
    103109            DO ji = 1, jpi 
    … …  
    110116         END DO 
    111117         ! 
    112          tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)  
     118!$OMP DO schedule(static) private(jj,ji) 
     119      DO jj = 1, jpj 
     120         DO ji = 1, jpi 
     121            tra(ji,jj,1,jpfer) = tra(ji,jj,1,jpfer) + zironice(ji,jj) 
     122         END DO 
     123      END DO 
     124!$OMP END PARALLEL 
    113125         !  
    114126         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
    … …  
    127139         !                                              ! Iron and Si deposition at the surface 
    128140         IF( ln_solub ) THEN 
    129             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     141!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     142           DO jj = 1, jpj 
     143              DO ji = 1, jpi 
     144                 zirondep(ji,jj,1) = solub(ji,jj) * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 
     145              END DO 
     146           END DO 
    130147         ELSE 
    131             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
     148!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     149           DO jj = 1, jpj 
     150              DO ji = 1, jpi 
     151                 zirondep(ji,jj,1) = dustsolub  * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 55.85 + 3.e-10 * r1_ryyss 
     152              END DO 
     153           END DO 
    132154         ENDIF 
    133          zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
    134          zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
     155!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     156         DO jj = 1, jpj 
     157            DO ji = 1, jpi 
     158               zsidep(ji,jj) = 8.8 * 0.075 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 28.1 
     159               zpdep (ji,jj,1) = 0.1 * 0.021 * dust(ji,jj) * mfrac * rfact2 / e3t_n(ji,jj,1) / 31. / po4r 
     160            END DO 
     161         END DO 
    135162         !                                              ! Iron solubilization of particles in the water column 
    136163         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    137164         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday ) 
     165!$OMP PARALLEL  
     166!$OMP DO schedule(static) private(jk,jj,ji) 
    138167         DO jk = 2, jpkm1 
    139             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
    140             zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023 
     168            DO jj = 1, jpj 
     169               DO ji = 1, jpi 
     170                  zirondep(ji,jj,jk) = dust(ji,jj) * mfrac * zwdust * rfact2 * EXP( -gdept_n(ji,jj,jk) / 540. ) 
     171                  zpdep   (ji,jj,jk) = zirondep(ji,jj,jk) * 0.023 
     172               END DO 
     173            END DO 
    141174         END DO 
    142175         !                                              ! Iron solubilization of particles in the water column 
    143          tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
    144          tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep   (:,:,:) 
    145          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)  
     176!$OMP DO schedule(static) private(jj,ji) 
     177         DO jj = 1, jpj 
     178            DO ji = 1, jpi 
     179               tra(ji,jj,1,jpsil) = tra(ji,jj,1,jpsil) + zsidep  (ji,jj) 
     180            END DO 
     181         END DO 
     182!$OMP DO schedule(static) private(jk,jj,ji) 
     183         DO jk = 1, jpk 
     184            DO jj = 1, jpj 
     185               DO ji = 1, jpi 
     186                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zpdep   (ji,jj,jk) 
     187                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zirondep(ji,jj,jk) 
     188               END DO 
     189            END DO 
     190         END DO 
     191!$OMP END PARALLEL  
    146192         !  
    147193         IF( lk_iomput ) THEN 
    … …  
    161207      ! ---------------------------------------------------------- 
    162208      IF( ln_river ) THEN 
     209!$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    163210         DO jj = 1, jpj 
    164211            DO ji = 1, jpi 
    … …  
    174221         ENDDO 
    175222         IF( ln_p5z ) THEN 
     223!$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    176224            DO jj = 1, jpj 
    177225               DO ji = 1, jpi 
    … …  
    189237      ! ---------------------------------------------------------- 
    190238      IF( ln_ndepo ) THEN 
    191          tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    192          tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
     239!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     240         DO jj = 1, jpj 
     241            DO ji = 1, jpi 
     242               tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + nitdep(ji,jj) * rfact2 
     243               tra(ji,jj,1,jptal) = tra(ji,jj,1,jptal) - rno3 * nitdep(ji,jj) * rfact2 
     244            ENDDO 
     245         ENDDO 
    193246      ENDIF 
    194247 
    … …  
    196249      ! ------------------------------------------------------ 
    197250      IF( ln_ironsed ) THEN 
    198                          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    199          IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 
     251!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     252         DO jk = 1, jpk 
     253            DO jj = 1, jpj 
     254               DO ji = 1, jpi 
     255                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ironsed(ji,jj,jk) * rfact2 
     256               END DO 
     257            END DO 
     258         END DO 
     259 
     260         IF( ln_ligand ) THEN 
     261!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     262            DO jk = 1, jpk 
     263               DO jj = 1, jpj 
     264                  DO ji = 1, jpi 
     265                     tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + ( ironsed(ji,jj,jk) * fep_rats ) * rfact2 
     266                  END DO 
     267               END DO 
     268            END DO 
     269         END IF 
    200270         ! 
    201271         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    … …  
    206276      ! ------------------------------------------------------ 
    207277      IF( ln_hydrofe ) THEN 
    208             tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
     278!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     279         DO jk = 1, jpk 
     280            DO jj = 1, jpj 
     281               DO ji = 1, jpi 
     282                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + hydrofe(ji,jj,jk) * rfact2 
     283               END DO 
     284            END DO 
     285         END DO 
    209286         IF( ln_ligand ) THEN 
    210             tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 
    211             tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
     287!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     288            DO jk = 1, jpk 
     289               DO jj = 1, jpj 
     290                  DO ji = 1, jpi 
     291                     tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + ( hydrofe(ji,jj,jk) * fep_rath ) * rfact2 
     292                     tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + ( hydrofe(ji,jj,jk) * lgw_rath ) * rfact2 
     293                  END DO 
     294               END DO 
     295            END DO 
    212296         ENDIF 
    213297         ! 
    … …  
    218302      ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    219303      ! -------------------------------------------------------------------- 
     304!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 
    220305      DO jj = 1, jpj 
    221306         DO ji = 1, jpi 
    … …  
    229314      ! 
    230315      IF( ln_ligand ) THEN 
     316!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep) 
    231317         DO jj = 1, jpj 
    232318            DO ji = 1, jpi 
    … …  
    242328         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    243329         ! ------------------------------------------------------- 
     330!$OMP PARALLEL 
     331!$OMP DO schedule(static) private(jj,ji,ikt,zflx,zo2,zno3,zdep) 
    244332         DO jj = 1, jpj 
    245333            DO ji = 1, jpi 
    … …  
    267355           ! The factor for calcite comes from the alkalinity effect 
    268356           ! ------------------------------------------------------------- 
     357!$OMP DO schedule(static) private(jj,ji,ikt,zfactcal) 
    269358           DO jj = 1, jpj 
    270359              DO ji = 1, jpi 
    … …  
    280369            END DO 
    281370         END DO 
     371!$OMP END PARALLEL 
    282372         zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
    283373         zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
    … …  
    291381      IF( .NOT.lk_sed )  zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 
    292382 
     383!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss)  
    293384      DO jj = 1, jpj 
    294385         DO ji = 1, jpi 
    … …  
    305396      ! 
    306397      IF( .NOT.lk_sed ) THEN 
     398!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwsc,zsiloss,zcaloss,zfactcal,zrivalk) 
    307399         DO jj = 1, jpj 
    308400            DO ji = 1, jpi 
    … …  
    325417      ENDIF 
    326418      ! 
     419!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 
    327420      DO jj = 1, jpj 
    328421         DO ji = 1, jpi 
    … …  
    339432      ! 
    340433      IF( ln_ligand ) THEN 
     434!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zwssfep) 
    341435         DO jj = 1, jpj 
    342436            DO ji = 1, jpi 
    … …  
    350444      ! 
    351445      IF( ln_p5z ) THEN 
     446!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4) 
    352447         DO jj = 1, jpj 
    353448            DO ji = 1, jpi 
    … …  
    367462         ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 
    368463         ! in the sediments and just above the sediments. Not very clever, but simpliest option. 
     464!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt,zdep,zws3,zws4,zrivno3,zwstpoc,zpdenit,z1pdenit,zolimit,zdenitt,zwstpop,zwstpon) 
    369465         DO jj = 1, jpj 
    370466            DO ji = 1, jpi 
    … …  
    402498      ! Small source iron from particulate inorganic iron 
    403499      !----------------------------------- 
     500!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    404501      DO jk = 1, jpkm1 
    405          zlight (:,:,jk) =  ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) )  
    406          zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 
     502         DO jj = 1, jpj 
     503            DO ji = 1, jpi 
     504               zlight (ji,jj,jk) =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) * ( 1. - fr_i(ji,jj) )  
     505               zsoufer(ji,jj,jk) = zlight(ji,jj,jk) * 2E-11 / ( 2E-11 + biron(ji,jj,jk) ) 
     506           END DO 
     507         END DO 
    407508      ENDDO 
    408509      IF( ln_p4z ) THEN 
     510!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zlim,zfact,ztrfer,ztrpo4s) 
    409511         DO jk = 1, jpkm1 
    410512            DO jj = 1, jpj 
    … …  
    423525         END DO 
    424526      ELSE       ! p5z 
     527!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztemp,zmudia,xdianh4,xdiano3,zlim,zfact,ztrfer,ztrdp) 
    425528         DO jk = 1, jpkm1 
    426529            DO jj = 1, jpj 
    … …  
    448551      ! ---------------------------------------- 
    449552      IF( ln_p4z ) THEN 
     553!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 
    450554         DO jk = 1, jpkm1 
    451555            DO jj = 1, jpj 
    … …  
    462566         END DO 
    463567      ELSE    ! p5z 
     568!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact) 
    464569         DO jk = 1, jpkm1 
    465570            DO jj = 1, jpj 
    … …  
    497602            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    498603            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated ) 
    499                zwork1(:,:) = 0. 
     604!$OMP PARALLEL 
     605!$OMP DO schedule(static) private(jj,ji)  
     606               DO jj = 1, jpj 
     607                  DO ji = 1, jpi 
     608                     zwork1(ji,jj) = 0. 
     609                  END DO 
     610               ENDDO 
    500611               DO jk = 1, jpkm1 
    501                  zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * e3t_n(:,:,jk) * tmask(:,:,jk) 
     612!$OMP DO schedule(static) private(jj,ji)  
     613                  DO jj = 1, jpj 
     614                     DO ji = 1, jpi 
     615                        zwork1(ji,jj) = zwork1(ji,jj) + nitrpot(ji,jj,jk) * nitrfix * zfact * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     616                     END DO 
     617                  END DO 
    502618               ENDDO 
     619!$OMP END PARALLEL 
    503620               CALL iom_put( "INTNFIX" , zwork1 )  
    504621            ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r7646 r7698  
    7474      ! Initialization of some global variables 
    7575      ! --------------------------------------- 
    76       prodpoc(:,:,:) = 0. 
    77       conspoc(:,:,:) = 0. 
    78       prodgoc(:,:,:) = 0. 
    79       consgoc(:,:,:) = 0. 
     76!$OMP PARALLEL 
     77!$OMP DO schedule(static) private(jk, jj, ji) 
     78      DO jk = 1, jpk 
     79         DO jj = 1, jpj 
     80            DO ji = 1,jpi 
     81               prodpoc(ji,jj,jk) = 0. 
     82               conspoc(ji,jj,jk) = 0. 
     83               prodgoc(ji,jj,jk) = 0. 
     84               consgoc(ji,jj,jk) = 0. 
     85            END DO 
     86         END DO 
     87      END DO 
    8088 
    8189      ! 
    … …  
    8391      !    by data and from the coagulation theory 
    8492      !    ----------------------------------------------------------- 
     93!$OMP DO schedule(static) private(jk, jj, ji, zmax, zfact) 
    8594      DO jk = 1, jpkm1 
    8695         DO jj = 1, jpj 
    … …  
    94103 
    95104      ! limit the values of the sinking speeds to avoid numerical instabilities   
    96       wsbio3(:,:,:) = wsbio 
     105!$OMP DO schedule(static) private(jk, jj, ji) 
     106      DO jk = 1, jpk 
     107         DO jj = 1, jpj 
     108            DO ji = 1, jpi 
     109               wsbio3(ji,jj,jk) = wsbio 
     110            END DO 
     111         END DO 
     112      END DO 
     113!$OMP END PARALLEL 
    97114 
    98115      ! 
    … …  
    112129        iiter1 = 1 
    113130        iiter2 = 1 
     131!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwsmax) REDUCTION(MAX:iiter1, iiter2) 
    114132        DO jk = 1, jpkm1 
    115133          DO jj = 1, jpj 
    … …  
    131149      ENDIF 
    132150 
     151!$OMP PARALLEL 
     152!$OMP DO schedule(static) private(jk, jj, ji, zwsmax) 
    133153      DO jk = 1,jpkm1 
    134154         DO jj = 1, jpj 
    … …  
    143163      END DO 
    144164 
    145       wscal (:,:,:) = wsbio4(:,:,:) 
    146  
    147165      !  Initializa to zero all the sinking arrays  
    148166      !   ----------------------------------------- 
    149       sinking (:,:,:) = 0.e0 
    150       sinking2(:,:,:) = 0.e0 
    151       sinkcal (:,:,:) = 0.e0 
    152       sinkfer (:,:,:) = 0.e0 
    153       sinksil (:,:,:) = 0.e0 
    154       sinkfer2(:,:,:) = 0.e0 
     167!$OMP DO schedule(static) private(jk, jj, ji) 
     168      DO jk = 1, jpk 
     169         DO jj = 1, jpj 
     170            DO ji = 1, jpi 
     171               sinking (ji,jj,jk) = 0.e0 
     172               sinking2(ji,jj,jk) = 0.e0 
     173               sinkcal (ji,jj,jk) = 0.e0 
     174               sinkfer (ji,jj,jk) = 0.e0 
     175               sinksil (ji,jj,jk) = 0.e0 
     176               sinkfer2(ji,jj,jk) = 0.e0 
     177               wscal (ji,jj,jk) = wsbio4(ji,jj,jk) 
     178            END DO 
     179         END DO 
     180      END DO 
     181!$OMP END PARALLEL 
    155182 
    156183      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    … …  
    169196 
    170197      IF( ln_p5z ) THEN 
    171          sinkingn (:,:,:) = 0.e0 
    172          sinking2n(:,:,:) = 0.e0 
    173          sinkingp (:,:,:) = 0.e0 
    174          sinking2p(:,:,:) = 0.e0 
     198!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     199         DO jk = 1, jpk 
     200            DO jj = 1, jpj 
     201               DO ji = 1, jpi 
     202                  sinkingn (ji,jj,jk) = 0.e0 
     203                  sinking2n(ji,jj,jk) = 0.e0 
     204                  sinkingp (ji,jj,jk) = 0.e0 
     205                  sinking2p(ji,jj,jk) = 0.e0 
     206               END DO 
     207            END DO 
     208         END DO 
    175209 
    176210         !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    … …  
    188222 
    189223      IF( ln_ligand ) THEN 
    190          wsfep (:,:,:) = wfep 
     224!$OMP PARALLEL 
     225!$OMP DO schedule(static) private(jk, jj, ji) 
     226         DO jk = 1, jpk 
     227            DO jj = 1, jpj 
     228               DO ji = 1, jpi 
     229                  wsfep (ji,jj,jk) = wfep 
     230               END DO 
     231            END DO 
     232         END DO 
     233!$OMP DO schedule(static) private(jk, jj, ji, zwsmax) 
    191234         DO jk = 1,jpkm1 
    192235            DO jj = 1, jpj 
    … …  
    199242            END DO 
    200243         END DO 
     244!$OMP END DO NOWAIT 
    201245         ! 
    202          sinkfep(:,:,:) = 0.e0 
     246!$OMP DO schedule(static) private(jk, jj, ji) 
     247         DO jk = 1, jpk 
     248            DO jj = 1, jpj 
     249               DO ji = 1, jpi 
     250                  sinkfep(ji,jj,jk) = 0.e0 
     251               END DO 
     252            END DO 
     253         END DO 
     254!$OMP END PARALLEL 
    203255         DO jit = 1, iiter1 
    204256           CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) 
    … …  
    217269          ! 
    218270          IF( iom_use( "EPC100" ) )  THEN 
    219               zw2d(:,:) = ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of carbon at 100m 
    220               CALL iom_put( "EPC100"  , zw2d ) 
     271!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     272             DO jj = 1, jpj 
     273                DO ji = 1, jpi 
     274                   zw2d(ji,jj) = ( sinking(ji,jj,ik100) + sinking2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of carbon at 100m 
     275                END DO 
     276             END DO 
     277             CALL iom_put( "EPC100"  , zw2d ) 
    221278          ENDIF 
    222279          IF( iom_use( "EPFE100" ) )  THEN 
    223               zw2d(:,:) = ( sinkfer(:,:,ik100) + sinkfer2(:,:,ik100) ) * zfact * tmask(:,:,1) ! Export of iron at 100m 
    224               CALL iom_put( "EPFE100"  , zw2d ) 
     280!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     281             DO jj = 1, jpj 
     282                DO ji = 1, jpi 
     283                   zw2d(ji,jj) = ( sinkfer(ji,jj,ik100) + sinkfer2(ji,jj,ik100) ) * zfact * tmask(ji,jj,1) ! Export of iron at 100m 
     284                END DO 
     285             END DO 
     286             CALL iom_put( "EPFE100"  , zw2d ) 
    225287          ENDIF 
    226288          IF( iom_use( "EPCAL100" ) )  THEN 
    227               zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 
    228               CALL iom_put( "EPCAL100"  , zw2d ) 
     289!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     290             DO jj = 1, jpj 
     291                DO ji = 1, jpi 
     292                   zw2d(ji,jj) = sinkcal(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of calcite at 100m 
     293                END DO 
     294             END DO 
     295             CALL iom_put( "EPCAL100"  , zw2d ) 
    229296          ENDIF 
    230297          IF( iom_use( "EPSI100" ) )  THEN 
    231               zw2d(:,:) =  sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 
    232               CALL iom_put( "EPSI100"  , zw2d ) 
     298!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     299             DO jj = 1, jpj 
     300                DO ji = 1, jpi 
     301                   zw2d(ji,jj) =  sinksil(ji,jj,ik100) * zfact * tmask(ji,jj,1) ! Export of bigenic silica at 100m 
     302                END DO 
     303             END DO 
     304             CALL iom_put( "EPSI100"  , zw2d ) 
    233305          ENDIF 
    234306          IF( iom_use( "EXPC" ) )  THEN 
    235               zw3d(:,:,:) = ( sinking(:,:,:) + sinking2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of carbon in the water column 
    236               CALL iom_put( "EXPC"  , zw3d ) 
     307!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     308             DO jk = 1, jpk 
     309                DO jj = 1, jpj 
     310                   DO ji = 1, jpi 
     311                      zw3d(ji,jj,jk) = ( sinking(ji,jj,jk) + sinking2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of carbon in the water column 
     312                   END DO 
     313                END DO 
     314             END DO 
     315             CALL iom_put( "EXPC"  , zw3d ) 
    237316          ENDIF 
    238317          IF( iom_use( "EXPFE" ) )  THEN 
    239               zw3d(:,:,:) = ( sinkfer(:,:,:) + sinkfer2(:,:,:) ) * zfact * tmask(:,:,:) ! Export of iron  
    240               CALL iom_put( "EXPFE"  , zw3d ) 
     318!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     319             DO jk = 1, jpk 
     320                DO jj = 1, jpj 
     321                   DO ji = 1, jpi 
     322                      zw3d(ji,jj,jk) = ( sinkfer(ji,jj,jk) + sinkfer2(ji,jj,jk) ) * zfact * tmask(ji,jj,jk) ! Export of iron  
     323                   END DO 
     324                END DO 
     325             END DO 
     326             CALL iom_put( "EXPFE"  , zw3d ) 
    241327          ENDIF 
    242328          IF( iom_use( "EXPCAL" ) )  THEN 
    243               zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite  
    244               CALL iom_put( "EXPCAL"  , zw3d ) 
     329!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     330             DO jk = 1, jpk 
     331                DO jj = 1, jpj 
     332                   DO ji = 1, jpi 
     333                      zw3d(ji,jj,jk) = sinkcal(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of calcite  
     334                   END DO 
     335                END DO 
     336             END DO 
     337             CALL iom_put( "EXPCAL"  , zw3d ) 
    245338          ENDIF 
    246339          IF( iom_use( "EXPSI" ) )  THEN 
    247               zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 
    248               CALL iom_put( "EXPSI"  , zw3d ) 
     340!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     341             DO jk = 1, jpk 
     342                DO jj = 1, jpj 
     343                   DO ji = 1, jpi 
     344                      zw3d(ji,jj,jk) = sinksil(ji,jj,jk) * zfact * tmask(ji,jj,jk) ! Export of bigenic silica 
     345                   END DO 
     346                END DO 
     347             END DO 
     348             CALL iom_put( "EXPSI"  , zw3d ) 
    249349          ENDIF 
    250350          IF( iom_use( "tcexp" ) )  CALL iom_put( "tcexp" , t_oce_co2_exp * zfact )   ! molC/s 
    … …  
    312412      zstep = rfact2 / REAL( kiter, wp ) / 2. 
    313413 
    314       ztraz(:,:,:) = 0.e0 
    315       zakz (:,:,:) = 0.e0 
    316       ztrb (:,:,:) = trb(:,:,:,jp_tra) 
    317  
     414!$OMP PARALLEL 
     415!$OMP DO schedule(static) private(jk, jj, ji) 
     416      DO jk = 1, jpk 
     417         DO jj = 1, jpj 
     418            DO ji = 1, jpi 
     419               ztraz(ji,jj,jk) = 0.e0 
     420               zakz (ji,jj,jk) = 0.e0 
     421               ztrb (ji,jj,jk) = trb(ji,jj,jk,jp_tra) 
     422            END DO 
     423         END DO 
     424      END DO 
     425!$OMP END DO NOWAIT 
     426!$OMP DO schedule(static) private(jk, jj, ji) 
    318427      DO jk = 1, jpkm1 
    319          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)  
    320       END DO 
    321       zwsink2(:,:,1) = 0.e0 
    322  
     428         DO jj = 1, jpj 
     429            DO ji = 1, jpi 
     430               zwsink2(ji,jj,jk+1) = -pwsink(ji,jj,jk) / rday * tmask(ji,jj,jk+1) 
     431            END DO 
     432         END DO 
     433      END DO 
     434 
     435!$OMP DO schedule(static) private(jj, ji) 
     436      DO jj = 1, jpj 
     437         DO ji = 1, jpi 
     438            zwsink2(ji,jj,1) = 0.e0 
     439         END DO 
     440      END DO 
     441!$OMP END DO NOWAIT 
    323442 
    324443      ! Vertical advective flux 
    325444      DO jn = 1, 2 
    326445         !  first guess of the slopes interior values 
     446!$OMP DO schedule(static) private(jk,jj,ji) 
    327447         DO jk = 2, jpkm1 
    328             ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk) 
    329          END DO 
    330          ztraz(:,:,1  ) = 0.0 
    331          ztraz(:,:,jpk) = 0.0 
     448            DO jj = 1, jpj 
     449               DO ji = 1, jpi 
     450                  ztraz(ji,jj,jk) = ( trb(ji,jj,jk-1,jp_tra) - trb(ji,jj,jk,jp_tra) ) * tmask(ji,jj,jk) 
     451               END DO 
     452            END DO 
     453         END DO 
     454!$OMP END DO NOWAIT 
     455!$OMP DO schedule(static) private(jj, ji) 
     456      DO jj = 1, jpj 
     457         DO ji = 1, jpi 
     458            ztraz(ji,jj,1  ) = 0.0 
     459            ztraz(ji,jj,jpk) = 0.0 
     460         END DO 
     461      END DO 
    332462 
    333463         ! slopes 
     464!$OMP DO schedule(static) private(jk, jj, ji, zign) 
    334465         DO jk = 2, jpkm1 
    335466            DO jj = 1,jpj 
    … …  
    342473          
    343474         ! Slopes limitation 
     475!$OMP DO schedule(static) private(jk, jj, ji) 
    344476         DO jk = 2, jpkm1 
    345477            DO jj = 1, jpj 
    … …  
    352484          
    353485         ! vertical advective flux 
     486!$OMP DO schedule(static) private(jk, jj, ji, zigma, zew) 
    354487         DO jk = 1, jpkm1 
    355488            DO jj = 1, jpj       
    … …  
    363496         ! 
    364497         ! Boundary conditions 
    365          psinkflx(:,:,1  ) = 0.e0 
    366          psinkflx(:,:,jpk) = 0.e0 
     498!$OMP DO schedule(static) private(jj, ji) 
     499         DO jj = 1, jpj 
     500            DO ji = 1, jpi 
     501               psinkflx(ji,jj,1  ) = 0.e0 
     502               psinkflx(ji,jj,jpk) = 0.e0 
     503            END DO 
     504         END DO 
    367505          
     506!$OMP DO schedule(static) private(jk, jj, ji, zflx) 
    368507         DO jk=1,jpkm1 
    369508            DO jj = 1,jpj 
    … …  
    377516      ENDDO 
    378517 
     518!$OMP DO schedule(static) private(jk, jj, ji, zflx) 
    379519      DO jk = 1,jpkm1 
    380520         DO jj = 1,jpj 
    … …  
    386526      END DO 
    387527 
    388       trb(:,:,:,jp_tra) = ztrb(:,:,:) 
    389       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
     528!$OMP DO schedule(static) private(jk, jj, ji) 
     529      DO jk = 1, jpk 
     530         DO jj = 1, jpj 
     531            DO ji = 1, jpi 
     532               trb(ji,jj,jk,jp_tra) = ztrb(ji,jj,jk) 
     533               psinkflx(ji,jj,jk)   = 2. * psinkflx(ji,jj,jk) 
     534            END DO 
     535         END DO 
     536      END DO 
     537!$OMP END PARALLEL 
    390538      ! 
    391539      CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r7646 r7698  
    9999      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
    100100         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    101             trb(:,:,:,jn) = trn(:,:,:,jn) 
     101!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     102            DO jk = 1, jpk 
     103               DO jj = 1, jpj 
     104                  DO ji = 1, jpi 
     105                     trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     106                  END DO 
     107               END DO 
     108            END DO 
    102109         END DO 
    103110      ENDIF 
    … …  
    125132         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
    126133         ! 
    127          xnegtr(:,:,:) = 1.e0 
     134!$OMP PARALLEL 
     135!$OMP DO schedule(static) private(jk, jj, ji) 
     136         DO jk = 1, jpk 
     137            DO jj = 1, jpj 
     138               DO ji = 1, jpi 
     139                  xnegtr(ji,jj,jk) = 1.e0 
     140               END DO 
     141            END DO 
     142         END DO 
    128143         DO jn = jp_pcs0, jp_pcs1 
     144!$OMP DO schedule(static) private(jk, jj, ji, ztra) 
    129145            DO jk = 1, jpk 
    130146               DO jj = 1, jpj 
    … …  
    141157         !                                !  
    142158         DO jn = jp_pcs0, jp_pcs1 
    143            trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     159!$OMP DO schedule(static) private(jk, jj, ji) 
     160            DO jk = 1, jpk 
     161               DO jj = 1, jpj 
     162                  DO ji = 1, jpi 
     163                     trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) + xnegtr(ji,jj,jk) * tra(ji,jj,jk,jn) 
     164                  END DO 
     165               END DO 
     166            END DO 
    144167         END DO 
    145168        ! 
    146169         DO jn = jp_pcs0, jp_pcs1 
    147             tra(:,:,:,jn) = 0._wp 
    148          END DO 
     170!$OMP DO schedule(static) private(jk, jj, ji) 
     171            DO jk = 1, jpk 
     172               DO jj = 1, jpj 
     173                  DO ji = 1, jpi 
     174                     tra(ji,jj,jk,jn) = 0._wp 
     175                  END DO 
     176               END DO 
     177            END DO 
     178         END DO 
     179!$OMP END PARALLEL 
    149180         ! 
    150181         IF( ln_top_euler ) THEN 
    151182            DO jn = jp_pcs0, jp_pcs1 
    152                trn(:,:,:,jn) = trb(:,:,:,jn) 
     183!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     184               DO jk = 1, jpk 
     185                  DO jj = 1, jpj 
     186                     DO ji = 1, jpi 
     187                        trn(ji,jj,jk,jn) = trb(ji,jj,jk,jn) 
     188                     END DO 
     189                  END DO 
     190               END DO 
    153191            END DO 
    154192         ENDIF 
    … …  
    349387      ! 
    350388      INTEGER, INTENT( in )  ::     kt ! time step 
     389      INTEGER ::   ji, jj, jk 
    351390      ! 
    352391      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    … …  
    357396      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 
    358397      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 
     398      REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil !workspace arrays 
     399      REAL(wp), POINTER, DIMENSION(:,:,:) :: zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil !workspace arrays 
    359400      !!--------------------------------------------------------------------- 
    360401 
    … …  
    366407      IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
    367408         !                                                ! --------------------------- ! 
     409         CALL wrk_alloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil ) 
     410         CALL wrk_alloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil ) 
     411 
    368412         ! set total alkalinity, phosphate, nitrate & silicate 
    369413         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
    370414 
    371          zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    372          zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    373          zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    374          zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    375   
    376          IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
    377          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
    378  
    379          IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
    380          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
    381  
    382          IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
    383          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
    384  
    385          IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
    386          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     415!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     416         DO jk = 1, jpk 
     417            DO jj = 1, jpj 
     418               DO ji = 1, jpi 
     419                  zctrn_jptal(ji,jj,jk) = trn(ji,jj,jk,jptal) * cvol(ji,jj,jk) 
     420                  zctrn_jppo4(ji,jj,jk) = trn(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 
     421                  zctrn_jppo3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 
     422                  zctrn_jpsil(ji,jj,jk) = trn(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 
     423               END DO 
     424            END DO 
     425         END DO 
     426 
     427         zalksumn = glob_sum( zctrn_jptal(:,:,:)  ) * zarea 
     428         zpo4sumn = glob_sum( zctrn_jppo4(:,:,:)  ) * zarea * po4r 
     429         zno3sumn = glob_sum( zctrn_jppo3(:,:,:)  ) * zarea * rno3 
     430         zsilsumn = glob_sum( zctrn_jpsil(:,:,:)  ) * zarea 
     431 
     432!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     433         DO jk = 1, jpk 
     434            DO jj = 1, jpj 
     435               DO ji = 1, jpi 
     436                  trn(ji,jj,jk,jpsil) = MIN( 400.e-6,trn(ji,jj,jk,jpsil) * silmean / zsilsumn ) 
     437                  trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) * alkmean / zalksumn 
     438                  trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) * po4mean / zpo4sumn 
     439                  trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) * no3mean / zno3sumn 
     440               END DO 
     441            END DO 
     442         END DO 
     443 
     444         IF(lwp) THEN 
     445                WRITE(numout,*) '       TALKN mean : ', zalksumn 
     446                WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
     447                WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
     448                WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
     449         END IF 
    387450         ! 
    388451         ! 
    389452         IF( .NOT. ln_top_euler ) THEN 
    390             zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    391             zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    392             zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    393             zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    394   
    395             IF(lwp) WRITE(numout,*) ' ' 
    396             IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
    397             trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
    398  
    399             IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
    400             trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
    401  
    402             IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
    403             trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
    404  
    405             IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
    406             trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     453!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     454            DO jk = 1, jpk 
     455               DO jj = 1, jpj 
     456                  DO ji = 1, jpi 
     457                     zctrb_jptal(ji,jj,jk) = trb(ji,jj,jk,jptal) * cvol(ji,jj,jk) 
     458                     zctrb_jppo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) * cvol(ji,jj,jk) 
     459                     zctrb_jppo3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * cvol(ji,jj,jk) 
     460                     zctrb_jpsil(ji,jj,jk) = trb(ji,jj,jk,jpsil) * cvol(ji,jj,jk) 
     461                  END DO 
     462               END DO 
     463            END DO 
     464 
     465            zalksumb = glob_sum( zctrb_jptal(:,:,:)  ) * zarea 
     466            zpo4sumb = glob_sum( zctrb_jppo4(:,:,:)  ) * zarea * po4r 
     467            zno3sumb = glob_sum( zctrb_jppo3(:,:,:)  ) * zarea * rno3 
     468            zsilsumb = glob_sum( zctrb_jpsil(:,:,:)  ) * zarea 
     469 
     470!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     471            DO jk = 1, jpk 
     472               DO jj = 1, jpj 
     473                  DO ji = 1, jpi 
     474                     trb(ji,jj,jk,jpsil) = MIN( 400.e-6,trb(ji,jj,jk,jpsil) * silmean / zsilsumb ) 
     475                     trb(ji,jj,jk,jptal) = trb(ji,jj,jk,jptal) * alkmean / zalksumb 
     476                     trb(ji,jj,jk,jppo4) = trb(ji,jj,jk,jppo4) * po4mean / zpo4sumb 
     477                     trb(ji,jj,jk,jpno3) = trb(ji,jj,jk,jpno3) * no3mean / zno3sumb 
     478                  END DO 
     479               END DO 
     480            END DO 
     481 
     482            IF(lwp) THEN 
     483                WRITE(numout,*) ' ' 
     484                WRITE(numout,*) '       TALKB mean : ', zalksumb 
     485                WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
     486                WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
     487                WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
     488            END IF 
    407489        ENDIF 
     490        ! 
     491        CALL wrk_dealloc( jpi, jpj, jpk, zctrb_jptal, zctrb_jppo4, zctrb_jppo3, zctrb_jpsil ) 
     492        CALL wrk_dealloc( jpi, jpj, jpk, zctrn_jptal, zctrn_jppo4, zctrn_jppo3, zctrn_jpsil ) 
    408493        ! 
    409494      ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r7646 r7698  
    191191      !-------------------------------------------------------------- 
    192192      IF( .NOT.ln_rsttr ) THEN   
    193          trn(:,:,:,jpdic) = sco2 
    194          trn(:,:,:,jpdoc) = bioma0 
    195          trn(:,:,:,jptal) = alka0 
    196          trn(:,:,:,jpoxy) = oxyg0 
    197          trn(:,:,:,jpcal) = bioma0 
    198          trn(:,:,:,jppo4) = po4 / po4r 
    199          trn(:,:,:,jppoc) = bioma0 
    200          trn(:,:,:,jpgoc) = bioma0 
    201          trn(:,:,:,jpbfe) = bioma0 * 5.e-6 
    202          trn(:,:,:,jpsil) = silic1 
    203          trn(:,:,:,jpdsi) = bioma0 * 0.15 
    204          trn(:,:,:,jpgsi) = bioma0 * 5.e-6 
    205          trn(:,:,:,jpphy) = bioma0 
    206          trn(:,:,:,jpdia) = bioma0 
    207          trn(:,:,:,jpzoo) = bioma0 
    208          trn(:,:,:,jpmes) = bioma0 
    209          trn(:,:,:,jpfer) = 0.6E-9 
    210          trn(:,:,:,jpsfe) = bioma0 * 5.e-6 
    211          trn(:,:,:,jpdfe) = bioma0 * 5.e-6 
    212          trn(:,:,:,jpnfe) = bioma0 * 5.e-6 
    213          trn(:,:,:,jpnch) = bioma0 * 12. / 55. 
    214          trn(:,:,:,jpdch) = bioma0 * 12. / 55. 
    215          trn(:,:,:,jpno3) = no3 
    216          trn(:,:,:,jpnh4) = bioma0 
    217          IF( ln_ligand) THEN 
    218             trn(:,:,:,jplgw) = 0.6E-9 
    219             trn(:,:,:,jpfep) = 0. * 5.e-6 
    220          ENDIF 
    221          IF( ln_p5z ) THEN 
    222             trn(:,:,:,jpdon) = bioma0 
    223             trn(:,:,:,jpdop) = bioma0 
    224             trn(:,:,:,jppon) = bioma0 
    225             trn(:,:,:,jppop) = bioma0 
    226             trn(:,:,:,jpgon) = bioma0 
    227             trn(:,:,:,jpgop) = bioma0 
    228             trn(:,:,:,jpnph) = bioma0 
    229             trn(:,:,:,jppph) = bioma0 
    230             trn(:,:,:,jppic) = bioma0 
    231             trn(:,:,:,jpnpi) = bioma0 
    232             trn(:,:,:,jpppi) = bioma0 
    233             trn(:,:,:,jpndi) = bioma0 
    234             trn(:,:,:,jppdi) = bioma0 
    235             trn(:,:,:,jppfe) = bioma0 * 5.e-6 
    236             trn(:,:,:,jppch) = bioma0 * 12. / 55. 
    237          ENDIF 
     193!$OMP PARALLEL 
     194!$OMP DO schedule(static) private(jk,jj,ji) 
     195         DO jk = 1, jpk 
     196            DO jj = 1, jpj 
     197               DO ji = 1, jpi 
     198                  trn(ji,jj,jk,jpdic) = sco2 
     199                  trn(ji,jj,jk,jpdoc) = bioma0 
     200                  trn(ji,jj,jk,jptal) = alka0 
     201                  trn(ji,jj,jk,jpoxy) = oxyg0 
     202                  trn(ji,jj,jk,jpcal) = bioma0 
     203                  trn(ji,jj,jk,jppo4) = po4 / po4r 
     204                  trn(ji,jj,jk,jppoc) = bioma0 
     205                  trn(ji,jj,jk,jpgoc) = bioma0 
     206                  trn(ji,jj,jk,jpbfe) = bioma0 * 5.e-6 
     207                  trn(ji,jj,jk,jpsil) = silic1 
     208                  trn(ji,jj,jk,jpdsi) = bioma0 * 0.15 
     209                  trn(ji,jj,jk,jpgsi) = bioma0 * 5.e-6 
     210                  trn(ji,jj,jk,jpphy) = bioma0 
     211                  trn(ji,jj,jk,jpdia) = bioma0 
     212                  trn(ji,jj,jk,jpzoo) = bioma0 
     213                  trn(ji,jj,jk,jpmes) = bioma0 
     214                  trn(ji,jj,jk,jpfer) = 0.6E-9 
     215                  trn(ji,jj,jk,jpsfe) = bioma0 * 5.e-6 
     216                  trn(ji,jj,jk,jpdfe) = bioma0 * 5.e-6 
     217                  trn(ji,jj,jk,jpnfe) = bioma0 * 5.e-6 
     218                  trn(ji,jj,jk,jpnch) = bioma0 * 12. / 55. 
     219                  trn(ji,jj,jk,jpdch) = bioma0 * 12. / 55. 
     220                  trn(ji,jj,jk,jpno3) = no3 
     221                  trn(ji,jj,jk,jpnh4) = bioma0 
     222                  IF( ln_ligand) THEN 
     223                     trn(ji,jj,jk,jplgw) = 0.6E-9 
     224                     trn(ji,jj,jk,jpfep) = 0. * 5.e-6 
     225                  ENDIF 
     226                  IF( ln_p5z ) THEN 
     227                     trn(ji,jj,jk,jpdon) = bioma0 
     228                     trn(ji,jj,jk,jpdop) = bioma0 
     229                     trn(ji,jj,jk,jppon) = bioma0 
     230                     trn(ji,jj,jk,jppop) = bioma0 
     231                     trn(ji,jj,jk,jpgon) = bioma0 
     232                     trn(ji,jj,jk,jpgop) = bioma0 
     233                     trn(ji,jj,jk,jpnph) = bioma0 
     234                     trn(ji,jj,jk,jppph) = bioma0 
     235                     trn(ji,jj,jk,jppic) = bioma0 
     236                     trn(ji,jj,jk,jpnpi) = bioma0 
     237                     trn(ji,jj,jk,jpppi) = bioma0 
     238                     trn(ji,jj,jk,jpndi) = bioma0 
     239                     trn(ji,jj,jk,jppdi) = bioma0 
     240                     trn(ji,jj,jk,jppfe) = bioma0 * 5.e-6 
     241                     trn(ji,jj,jk,jppch) = bioma0 * 12. / 55. 
     242                  ENDIF 
     243               END DO 
     244            END DO 
     245         END DO 
    238246         ! initialize the half saturation constant for silicate 
    239247         ! ---------------------------------------------------- 
    240          xksi(:,:)    = 2.e-6 
    241          xksimax(:,:) = xksi(:,:) 
     248!$OMP DO schedule(static) private(jj,ji) 
     249         DO jj = 1, jpj 
     250            DO ji = 1, jpi 
     251               xksi(ji,jj)    = 2.e-6 
     252               xksimax(ji,jj) = xksi(ji,jj) 
     253            END DO 
     254         END DO 
     255!$OMP END PARALLEL 
    242256      END IF 
    243257 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r7646 r7698  
    6161   !!---------------------------------------------------------------------- 
    6262   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    63    !! $Id$  
     63   !! $Id$ 
    6464   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 
    … …  
    7676      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7777      ! 
    78       INTEGER ::   jk   ! dummy loop index 
     78      INTEGER ::   jk, jj, ji   ! dummy loop index 
    7979      CHARACTER (len=22) ::   charout 
    8080      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    … …  
    8686      !                                               !==  effective transport  ==! 
    8787      IF( l_offline ) THEN 
    88          zun(:,:,:) = un(:,:,:)     ! effective transport already in un/vn/wn 
    89          zvn(:,:,:) = vn(:,:,:) 
    90          zwn(:,:,:) = wn(:,:,:) 
     88!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     89         DO jk = 1, jpk 
     90            DO jj = 1, jpj 
     91               DO ji = 1, jpi 
     92                  zun(ji,jj,jk) = un(ji,jj,jk)     ! effective transport already in un/vn/wn 
     93                  zvn(ji,jj,jk) = vn(ji,jj,jk) 
     94                  zwn(ji,jj,jk) = wn(ji,jj,jk) 
     95               END DO 
     96            END DO 
     97         END DO 
    9198      ELSE 
    9299         !        
     100!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    93101         DO jk = 1, jpkm1 
    94             zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    95             zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    96             zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     102            DO jj = 1, jpj 
     103               DO ji = 1, jpi 
     104                  zun(ji,jj,jk) = e2u  (ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)                   ! eulerian transport 
     105                  zvn(ji,jj,jk) = e1v  (ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     106                  zwn(ji,jj,jk) = e1e2t(ji,jj)                   * wn(ji,jj,jk) 
     107               END DO 
     108            END DO 
    97109         END DO 
    98110         ! 
    99111         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    100             zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    101             zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     112!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     113            DO jk = 1, jpk 
     114               DO jj = 1, jpj 
     115                  DO ji = 1, jpi 
     116                     zun(ji,jj,jk) = zun(ji,jj,jk) + un_td(ji,jj,jk) 
     117                     zvn(ji,jj,jk) = zvn(ji,jj,jk) + vn_td(ji,jj,jk) 
     118                  END DO 
     119               END DO 
     120            END DO 
    102121         ENDIF 
    103122         ! 
    … …  
    107126         IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
    108127         ! 
    109          zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
    110          zvn(:,:,jpk) = 0._wp 
    111          zwn(:,:,jpk) = 0._wp 
     128!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     129         DO jj = 1, jpj 
     130            DO ji = 1, jpi 
     131               zun(ji,jj,jpk) = 0._wp                                               ! no transport trough the bottom 
     132               zvn(ji,jj,jpk) = 0._wp 
     133               zwn(ji,jj,jpk) = 0._wp 
     134            END DO 
     135         END DO 
    112136         ! 
    113137      ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r7646 r7698  
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    33    !! $Id$  
     33   !! $Id$ 
    3434   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3535   !!---------------------------------------------------------------------- 
    … …  
    6161      IF( l_trdtrc )  THEN 
    6262         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
    63          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     63!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     64         DO jn = 1, jptra 
     65            DO jk = 1, jpk 
     66               DO jj = 1, jpj 
     67                  DO ji = 1, jpi 
     68                     ztrtrd(ji,jj,jk,jn)  = tra(ji,jj,jk,jn) 
     69                  END DO 
     70               END DO 
     71            END DO 
     72         END DO 
    6473      ENDIF 
    6574 
    … …  
    8897      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    8998        DO jn = 1, jptra 
    90            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     99!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     100            DO jk = 1, jpk 
     101               DO jj = 1, jpj 
     102                  DO ji = 1, jpi 
     103                     ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk,jn) 
     104                  END DO 
     105               END DO 
     106            END DO 
    91107           CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    92108        END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r6403 r7698  
    7676      IF( l_trdtrc )  THEN 
    7777         CALL wrk_alloc( jpi,jpj,jpk,jptra,   ztrtrd ) 
    78          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     78!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     79         DO jn = 1, jptra 
     80            DO jk = 1, jpk 
     81               DO jj = 1, jpj 
     82                  DO ji = 1, jpi 
     83                     ztrtrd(ji,jj,jk,jn)  = tra(ji,jj,jk,jn) 
     84                  END DO 
     85               END DO 
     86            END DO 
     87         END DO 
    7988      ENDIF 
    8089      !                                  !* set the lateral diffusivity coef. for passive tracer       
    8190      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv ) 
    82       zahu(:,:,:) = rldf * ahtu(:,:,:)  
    83       zahv(:,:,:) = rldf * ahtv(:,:,:) 
     91!$OMP PARALLEL 
     92!$OMP DO schedule(static) private(jk,jj,ji) 
     93      DO jk = 1, jpk 
     94         DO jj = 1, jpj 
     95            DO ji = 1, jpi 
     96               zahu(ji,jj,jk) = rldf * ahtu(ji,jj,jk)  
     97               zahv(ji,jj,jk) = rldf * ahtv(ji,jj,jk) 
     98            END DO 
     99         END DO 
     100      END DO 
    84101      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain 
     102!$OMP DO schedule(static) private(jk,jj,ji,zdep) 
    85103      DO jk= 1, jpk 
    86104         DO jj = 1, jpj 
    … …  
    93111         END DO 
    94112      END DO 
     113!$OMP END DO NOWAIT 
     114!$OMP END PARALLEL 
    95115      ! 
    96116      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend 
    … …  
    112132      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    113133        DO jn = 1, jptra 
    114            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     134!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     135           DO jk = 1, jpk 
     136              DO jj = 1, jpj 
     137                 DO ji = 1, jpi 
     138                    ztrtrd(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk,jn) 
     139                 END DO 
     140              END DO 
     141           END DO 
    115142           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    116143        END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r7646 r7698  
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    48    !! $Id$  
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 
    … …  
    7777      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    7878      ! 
    79       INTEGER  ::   jk, jn   ! dummy loop indices 
     79      INTEGER  ::   jk, jn, jj, ji   ! dummy loop indices 
    8080      REAL(wp) ::   zfact            ! temporary scalar 
    8181      CHARACTER (len=22) :: charout 
    … …  
    101101      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application 
    102102         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 
    103          ztrdt(:,:,:,:)  = trn(:,:,:,:) 
     103!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     104         DO jn = 1, jptra 
     105            DO jk = 1, jpk 
     106               DO jj = 1, jpj 
     107                  DO ji = 1, jpi 
     108                     ztrdt(ji,jj,jk,jn)  = trn(ji,jj,jk,jn) 
     109                  END DO 
     110               END DO 
     111            END DO 
     112         END DO 
    104113      ENDIF 
    105114      !                                ! Leap-Frog + Asselin filter time stepping 
    106115      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap) 
     116!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
    107117         DO jn = 1, jptra 
    108118            DO jk = 1, jpkm1 
    109                trn(:,:,jk,jn) = tra(:,:,jk,jn) 
     119               DO jj = 1, jpj 
     120                  DO ji = 1, jpi 
     121                     trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 
     122                  END DO 
     123               END DO 
    110124            END DO 
    111125         END DO 
    … …  
    127141            DO jk = 1, jpkm1 
    128142               zfact = 1._wp / r2dttrc   
    129                ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
     143!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     144               DO jj = 1, jpj 
     145                  DO ji = 1, jpi 
     146                     ztrdt(ji,jj,jk,jn) = ( trb(ji,jj,jk,jn) - ztrdt(ji,jj,jk,jn) ) * zfact 
     147                  END DO 
     148               END DO 
    130149               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
    131150            END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r7646 r7698  
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    31    !! $Id$  
     31   !! $Id$ 
    3232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    … …  
    140140      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    141141      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
     142      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin   ! workspace arrays 
    142143      REAL(wp) :: zs2rdt 
    143144      LOGICAL ::   lldebug = .FALSE. 
    … …  
    147148      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
    148149       
     150      CALL wrk_alloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 
    149151      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    150152       
    … …  
    155157 
    156158            IF( l_trdtrc ) THEN 
    157                ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    158                ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
     159!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     160               DO jk = 1, jpk 
     161                  DO jj = 1, jpj 
     162                     DO ji = 1, jpi 
     163                        ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn)                        ! save input trb for trend computation 
     164                        ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 
     165                     END DO 
     166                  END DO 
     167               END DO 
    159168            ENDIF 
    160169            !                                                         ! sum over the global domain  
    161             ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
    162             ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
    163  
    164             ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
    165             ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
     170!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     171            DO jk = 1, jpk 
     172               DO jj = 1, jpj 
     173                  DO ji = 1, jpi 
     174                     zcptrbmin(ji,jj,jk) = MIN( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
     175                     zcptrnmin(ji,jj,jk) = MIN( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
     176                     zcptrbmax(ji,jj,jk) = MAX( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
     177                     zcptrnmax(ji,jj,jk) = MAX( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
     178                  END DO 
     179               END DO 
     180            END DO 
     181            ztrcorb = glob_sum( zcptrbmin(:,:,:) ) 
     182            ztrcorn = glob_sum( zcptrnmin(:,:,:) ) 
     183            ztrmasb = glob_sum( zcptrbmax(:,:,:) ) 
     184            ztrmasn = glob_sum( zcptrnmax(:,:,:) ) 
    166185 
    167186            IF( ztrcorb /= 0 ) THEN 
    168187               zcoef = 1. + ztrcorb / ztrmasb 
     188!$OMP PARALLEL DO schedule(static) private(jk) 
    169189               DO jk = 1, jpkm1 
    170                   ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 
    171                   ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
     190                  DO jj = 1, jpj 
     191                     DO ji = 1, jpi 
     192                        ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 
     193                        ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 
     194                     END DO 
     195                  END DO 
    172196               END DO 
    173197            ENDIF 
    … …  
    175199            IF( ztrcorn /= 0 ) THEN 
    176200               zcoef = 1. + ztrcorn / ztrmasn 
     201!$OMP PARALLEL DO schedule(static) private(jk) 
    177202               DO jk = 1, jpkm1 
    178                   ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 
    179                   ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
     203                  DO jj = 1, jpj 
     204                     DO ji = 1, jpi 
     205                        ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 
     206                        ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 
     207                     END DO 
     208                  END DO 
    180209               END DO 
    181210            ENDIF 
    … …  
    184213               ! 
    185214               zs2rdt = 1. / ( 2. * rdt ) 
    186                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    187                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     215!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     216               DO jk = 1, jpk 
     217                  DO jj = 1, jpj 
     218                     DO ji = 1, jpi 
     219                        ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 
     220                        ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 
     221                     END DO 
     222                  END DO 
     223               END DO 
     224 
    188225               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
    189226               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    … …  
    199236 
    200237           IF( l_trdtrc ) THEN 
    201               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    202               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
    203            ENDIF 
    204  
    205             DO jk = 1, jpkm1 
    206                DO jj = 1, jpj 
    207                   DO ji = 1, jpi 
    208                      ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 
    209                      ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 
    210                   END DO 
    211                END DO 
    212             END DO 
    213           
    214             IF( l_trdtrc ) THEN 
     238!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     239              DO jk = 1, jpk 
     240                 DO jj = 1, jpj 
     241                    DO ji = 1, jpi 
     242                       ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn)                        ! save input trb for trend computation 
     243                       ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 
     244                    END DO 
     245                 END DO 
     246              END DO 
     247           END IF 
     248 
     249!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     250           DO jk = 1, jpkm1 
     251              DO jj = 1, jpj 
     252                 DO ji = 1, jpi 
     253                    ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 
     254                    ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 
     255                 END DO 
     256              END DO 
     257           END DO 
     258 
     259           IF( l_trdtrc ) THEN 
    215260               ! 
    216261               zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 
    217                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    218                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     262!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     263               DO jk = 1, jpk 
     264                  DO jj = 1, jpj 
     265                     DO ji = 1, jpi 
     266                        ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 
     267                        ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 
     268                     END DO 
     269                  END DO 
     270               END DO 
    219271               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
    220272               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    … …  
    227279 
    228280      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
     281      CALL wrk_dealloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 
    229282 
    230283   END SUBROUTINE trc_rad_sms 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r7646 r7698  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    34    !! $Id$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    6161      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    6262      ! 
    63       INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
     63      INTEGER  ::   ji, jj, jk, jn                                     ! dummy loop indices 
    6464      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
    6565      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
    … …  
    8383      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    8484      END SELECT 
     85 
    8586 
    8687      IF( kt == nittrc000 ) THEN 
    … …  
    9899         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    99100           zfact = 1._wp 
    100            sbc_trc_b(:,:,:) = 0._wp 
     101!$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 
     102           DO jn = 1, jptra 
     103              DO jj = 1, jpj 
     104                 DO ji = 1, jpi 
     105                    sbc_trc_b(ji,jj,jn) = 0._wp 
     106                 END DO 
     107              END DO 
     108           END DO 
    101109         ENDIF 
    102110      ELSE                                         ! Swap of forcing fields 
    103111         IF( ln_top_euler ) THEN 
    104112            zfact = 1._wp 
    105             sbc_trc_b(:,:,:) = 0._wp 
     113!$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 
     114           DO jn = 1, jptra 
     115              DO jj = 1, jpj 
     116                 DO ji = 1, jpi 
     117                    sbc_trc_b(ji,jj,jn) = 0._wp 
     118                 END DO 
     119              END DO 
     120           END DO 
    106121         ELSE 
    107122            zfact = 0.5_wp 
    108             sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 
     123!$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 
     124           DO jn = 1, jptra 
     125              DO jj = 1, jpj 
     126                 DO ji = 1, jpi 
     127                    sbc_trc_b(ji,jj,jn) = sbc_trc(ji,jj,jn) 
     128                 END DO 
     129              END DO 
     130           END DO 
    109131         ENDIF 
    110132         ! 
    … …  
    116138      ! 
    117139      IF( .NOT.ln_linssh ) THEN  ! online coupling with vvl 
    118          zsfx(:,:) = 0._wp 
     140!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     141         DO jj = 1, jpj 
     142            DO ji = 1, jpi 
     143               zsfx(ji,jj) = 0._wp 
     144            END DO 
     145         END DO 
    119146      ELSE                                      ! online coupling free surface or offline with free surface 
    120          zsfx(:,:) = emp(:,:) 
     147!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     148         DO jj = 1, jpj 
     149            DO ji = 1, jpi 
     150               zsfx(ji,jj) = emp(ji,jj) 
     151            END DO 
     152         END DO 
    121153      ENDIF 
    122154 
    … …  
    124156      DO jn = 1, jptra 
    125157         ! 
    126          IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    127  
     158         IF( l_trdtrc ) THEN 
     159!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     160           DO jk = 1, jpk 
     161              DO jj = 1, jpj 
     162                 DO ji = 1, jpi 
     163                    ztrtrd(ji,jj,jk) = tra(ji,jj,jk,jn)  ! save trends 
     164                 END DO 
     165              END DO 
     166           END DO                                      ! online coupling free surface or offline with free surface 
     167         END IF 
    128168         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
    129169 
     170!$OMP PARALLEL DO schedule(static) private(jj, ji)  
    130171            DO jj = 2, jpj 
    131172               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    136177         ELSE 
    137178 
     179!$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t,zftra,zcd,ztfx,zdtra,zratio) 
    138180            DO jj = 2, jpj 
    139181               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    159201         CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 
    160202         !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
     203!$OMP PARALLEL DO schedule(static) private(jj,ji,zse3t)  
    161204         DO jj = 2, jpj 
    162205            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    167210         ! 
    168211         IF( l_trdtrc ) THEN 
    169             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
     212!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     213            DO jk = 1, jpk 
     214               DO jj = 1, jpj 
     215                  DO ji = 1, jpi 
     216                     ztrtrd(ji,jj,jk) = tra(ji,jj,jk,jn) - ztrtrd(ji,jj,jk) 
     217                  END DO 
     218               END DO 
     219            END DO                                      ! online coupling free surface or offline with free surface 
    170220            CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 
    171221         END IF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r7646 r7698  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    42    !! $Id$  
     42   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    5353      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
    5454      ! 
    55       INTEGER               ::  jk, jn 
     55      INTEGER               ::  jk, jn, jj, ji 
    5656      CHARACTER (len=22)    :: charout 
    5757      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace 
    … …  
    6262      IF( l_trdtrc )  THEN 
    6363         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    64          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     64!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     65         DO jn = 1, jptra 
     66            DO jk = 1, jpk 
     67               DO jj = 1, jpj 
     68                  DO ji = 1, jpi 
     69                     ztrtrd(ji,jj,jk,jn)  = tra(ji,jj,jk,jn) 
     70                  END DO 
     71               END DO 
     72            END DO 
     73         END DO 
    6574      ENDIF 
    6675 
    … …  
    7281      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    7382         DO jn = 1, jptra 
     83!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    7484            DO jk = 1, jpkm1 
    75                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
     85               DO jj = 1, jpj 
     86                  DO ji = 1, jpi 
     87                     ztrtrd(ji,jj,jk,jn) = ( ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / r2dttrc ) - ztrtrd(ji,jj,jk,jn) 
     88                  END DO 
     89               END DO 
    7690            END DO 
    7791            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcice.F90

    r7646 r7698  
    3838      !!--------------------------------------------------------------------- 
    3939      ! --- Variable declarations --- ! 
     40      INTEGER :: jn, jj, ji      ! dummy loop indices 
    4041 
    4142      IF(lwp) THEN 
    … …  
    4950      CALL trc_nam_ice 
    5051      ! 
    51       trc_i(:,:,:) = 0.0d0 ! by default 
    52       trc_o(:,:,:) = 0.0d0 ! by default 
     52!$OMP PARALLEL DO schedule(static) private(jn,jj,ji) 
     53      DO jn = 1, jptra 
     54         DO jj = 1, jpj 
     55            DO ji = 1, jpi 
     56               trc_i(ji,jj,jn) = 0.0d0 ! by default 
     57               trc_o(ji,jj,jn) = 0.0d0 ! by default 
     58            END DO 
     59         END DO 
     60      END DO 
    5361 
    5462      IF ( nn_ice_tr == 1 ) THEN 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7646 r7698  
    105105      !! ** Purpose :      passive tracers inventories at initialsation phase 
    106106      !!---------------------------------------------------------------------- 
    107       INTEGER ::  jk, jn    ! dummy loop indices 
     107      INTEGER ::  jk, jn, jj, ji    ! dummy loop indices 
    108108      CHARACTER (len=25) :: charout 
    109109      !!---------------------------------------------------------------------- 
    110110      !                                                              ! masked grid volume 
     111!$OMP PARALLEL 
     112!$OMP DO schedule(static) private(jk,jj,ji) 
    111113      DO jk = 1, jpk 
    112          cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    113       END DO 
     114         DO jj = 1, jpj 
     115            DO ji = 1, jpi 
     116               cvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     117            END DO 
     118         END DO 
     119      END DO 
     120      ! 
     121!$OMP DO schedule(static) private(jn) 
     122      DO jn = 1, jptra 
     123         trai(jn) = 0._wp                                               ! initial content of all tracers 
     124      END DO 
     125!$OMP END PARALLEL 
    114126      !                                                              ! total volume of the ocean  
    115127      areatot = glob_sum( cvol(:,:,:) ) 
    116128      ! 
    117       trai(:) = 0._wp                                                   ! initial content of all tracers 
    118129      DO jn = 1, jptra 
    119130         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    … …  
    220231      USE trcdta          ! initialisation from files 
    221232      ! 
    222       INTEGER :: jn, jl   ! dummy loop indices 
     233      INTEGER :: jn, jl, jk, jj, ji   ! dummy loop indices 
    223234      !!---------------------------------------------------------------------- 
    224235      ! 
    … …  
    254265        ENDIF 
    255266        ! 
    256         trb(:,:,:,:) = trn(:,:,:,:) 
     267!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     268        DO jn = 1, jptra 
     269           DO jk = 1, jpk 
     270              DO jj = 1, jpj 
     271                 DO ji = 1, jpi 
     272                    trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     273                 END DO 
     274              END DO 
     275           END DO 
     276        END DO 
    257277        !  
    258278      ENDIF 
    259279  
    260       tra(:,:,:,:) = 0._wp 
     280!$OMP PARALLEL DO schedule(static) private(jn,jk,jj,ji) 
     281      DO jn = 1, jptra 
     282         DO jk = 1, jpk 
     283            DO jj = 1, jpj 
     284               DO ji = 1, jpi 
     285                  tra(ji,jj,jk,jn) = 0._wp 
     286               END DO 
     287            END DO 
     288         END DO 
     289      END DO 
    261290      !                                                         ! Partial top/bottom cell: GRADh(trn) 
    262291   END SUBROUTINE trc_ini_state 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7646 r7698  
    268268      !! ** purpose  :   Compute tracers statistics 
    269269      !!---------------------------------------------------------------------- 
    270       INTEGER  :: jk, jn 
     270      INTEGER  :: jk, jj, ji, jn 
    271271      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
    272272      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 
    … …  
    279279      ENDIF 
    280280      ! 
     281!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    281282      DO jk = 1, jpk 
    282          zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
     283         DO jj = 1, jpj 
     284            DO ji = 1, jpi 
     285               zvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
     286            END DO 
     287         END DO 
    283288      END DO 
    284289      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r7646 r7698  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    39    !! $Id$  
     39   !! $Id$ 
    4040   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
    … …  
    5353      !!------------------------------------------------------------------- 
    5454      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
    55       INTEGER               ::  jk, jn  ! dummy loop indices 
     55      INTEGER               ::  jk, jn, jj, ji  ! dummy loop indices 
    5656      REAL(wp)              ::  ztrai 
    5757      CHARACTER (len=25)    ::  charout  
    … …  
    7070      ! 
    7171      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution 
     72!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    7273         DO jk = 1, jpk 
    73             cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
     74            DO jj = 1, jpj 
     75               DO ji = 1, jpi 
     76                  cvol(ji,jj,jk) = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     77               END DO 
     78            END DO 
    7479         END DO 
    7580         areatot         = glob_sum( cvol(:,:,:) ) 
    … …  
    8792         ENDIF 
    8893         ! 
    89          tra(:,:,:,:) = 0.e0 
     94         DO jn = 1, jptra 
     95!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     96            DO jk = 1, jpk 
     97               DO jj = 1, jpj 
     98                  DO ji = 1, jpi 
     99                     tra(ji,jj,jk,jn) = 0._wp 
     100                  END DO 
     101               END DO 
     102            END DO 
     103         END DO 
    90104         ! 
    91105                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
Note: See TracChangeset for help on using the changeset viewer.