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/OPA_SRC/SBC/sbcssm.F90 – NEMO

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

update trunk with OpenMP parallelization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r7646 r7698  
    5959      ! 
    6060      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
     61!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    6162      DO jj = 1, jpj 
    6263         DO ji = 1, jpi 
     
    6869      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    6970         !                                                ! ---------------------------------------- ! 
    70          ssu_m(:,:) = ub(:,:,1) 
    71          ssv_m(:,:) = vb(:,:,1) 
    72          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    73          ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    74          ENDIF 
    75          sss_m(:,:) = zts(:,:,jp_sal) 
     71!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     72         DO jj = 1, jpj 
     73            DO ji = 1, jpi 
     74               ssu_m(ji,jj) = ub(ji,jj,1) 
     75               ssv_m(ji,jj) = vb(ji,jj,1) 
     76            END DO 
     77         END DO 
     78         IF( l_useCT )  THEN 
     79           sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     80         ELSE                     
     81!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     82            DO jj = 1, jpj 
     83               DO ji = 1, jpi 
     84                  sst_m(ji,jj) = zts(ji,jj,jp_tem) 
     85               END DO 
     86            END DO 
     87         ENDIF 
     88!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     89         DO jj = 1, jpj 
     90            DO ji = 1, jpi 
     91               sss_m(ji,jj) = zts(ji,jj,jp_sal) 
     92            END DO 
     93         END DO 
    7694         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    77          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    78          ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
    79          ENDIF 
    80          ! 
    81          e3t_m(:,:) = e3t_n(:,:,1) 
    82          ! 
    83          frq_m(:,:) = fraqsr_1lev(:,:) 
     95         IF( ln_apr_dyn ) THEN   
     96!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     97            DO jj = 1, jpj 
     98               DO ji = 1, jpi 
     99                  ssh_m(ji,jj) = sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
     100               END DO 
     101            END DO 
     102         ELSE                     
     103!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     104            DO jj = 1, jpj 
     105               DO ji = 1, jpi 
     106                  ssh_m(ji,jj) = sshn(ji,jj) 
     107               END DO 
     108            END DO 
     109         ENDIF 
     110         ! 
     111!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     112         DO jj = 1, jpj 
     113            DO ji = 1, jpi 
     114               e3t_m(ji,jj) = e3t_n(ji,jj,1) 
     115         ! 
     116               frq_m(ji,jj) = fraqsr_1lev(ji,jj) 
     117            END DO 
     118         END DO 
    84119         ! 
    85120      ELSE 
     
    91126            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    92127            zcoef = REAL( nn_fsbc - 1, wp ) 
    93             ssu_m(:,:) = zcoef * ub(:,:,1) 
    94             ssv_m(:,:) = zcoef * vb(:,:,1) 
    95             IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    96             ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     128!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     129            DO jj = 1, jpj 
     130               DO ji = 1, jpi 
     131                  ssu_m(ji,jj) = zcoef * ub(ji,jj,1) 
     132                  ssv_m(ji,jj) = zcoef * vb(ji,jj,1) 
     133               END DO 
     134            END DO 
     135            IF( l_useCT )  THEN 
     136              sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     137            ELSE                     
     138!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     139              DO jj = 1, jpj 
     140                 DO ji = 1, jpi 
     141                    sst_m(ji,jj) = zcoef * zts(ji,jj,jp_tem) 
     142                 END DO 
     143              END DO 
    97144            ENDIF 
    98             sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
     145!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     146            DO jj = 1, jpj 
     147               DO ji = 1, jpi 
     148                  sss_m(ji,jj) = zcoef * zts(ji,jj,jp_sal) 
     149               END DO 
     150            END DO 
    99151            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    100             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    101             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     152            IF( ln_apr_dyn ) THEN    
     153!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     154               DO jj = 1, jpj 
     155                  DO ji = 1, jpi 
     156                     ssh_m(ji,jj) = zcoef * ( sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) ) 
     157                  END DO 
     158               END DO 
     159            ELSE                     
     160!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     161               DO jj = 1, jpj 
     162                  DO ji = 1, jpi 
     163                     ssh_m(ji,jj) = zcoef * sshn(ji,jj) 
     164                  END DO 
     165               END DO 
    102166            ENDIF 
    103167            ! 
    104             e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
    105             ! 
    106             frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
     168!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     169            DO jj = 1, jpj 
     170               DO ji = 1, jpi 
     171                  e3t_m(ji,jj) = zcoef * e3t_n(ji,jj,1) 
     172                  ! 
     173                  frq_m(ji,jj) = zcoef * fraqsr_1lev(ji,jj) 
     174               END DO 
     175            END DO 
    107176            !                                             ! ---------------------------------------- ! 
    108177         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    109178            !                                             ! ---------------------------------------- ! 
    110             ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields 
    111             ssv_m(:,:) = 0._wp 
    112             sst_m(:,:) = 0._wp 
    113             sss_m(:,:) = 0._wp 
    114             ssh_m(:,:) = 0._wp 
    115             e3t_m(:,:) = 0._wp 
    116             frq_m(:,:) = 0._wp 
     179!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     180            DO jj = 1, jpj 
     181               DO ji = 1, jpi 
     182                  ssu_m(ji,jj) = 0._wp     ! reset to zero ocean mean sbc fields 
     183                  ssv_m(ji,jj) = 0._wp 
     184                  sst_m(ji,jj) = 0._wp 
     185                  sss_m(ji,jj) = 0._wp 
     186                  ssh_m(ji,jj) = 0._wp 
     187                  e3t_m(ji,jj) = 0._wp 
     188                  frq_m(ji,jj) = 0._wp 
     189               END DO 
     190            END DO 
    117191         ENDIF 
    118192         !                                                ! ---------------------------------------- ! 
    119193         !                                                !        Cumulate at each time step        ! 
    120194         !                                                ! ---------------------------------------- ! 
    121          ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    122          ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    123          IF( l_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    124          ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    125          ENDIF 
    126          sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
     195!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     196         DO jj = 1, jpj 
     197            DO ji = 1, jpi 
     198               ssu_m(ji,jj) = ssu_m(ji,jj) + ub(ji,jj,1) 
     199               ssv_m(ji,jj) = ssv_m(ji,jj) + vb(ji,jj,1) 
     200            END DO 
     201         END DO 
     202         IF( l_useCT )  THEN    
     203           sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     204         ELSE                    
     205!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     206           DO jj = 1, jpj 
     207              DO ji = 1, jpi 
     208                 sst_m(ji,jj) = sst_m(ji,jj) + zts(ji,jj,jp_tem) 
     209              END DO 
     210           END DO 
     211         ENDIF 
     212!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     213         DO jj = 1, jpj 
     214            DO ji = 1, jpi 
     215               sss_m(ji,jj) = sss_m(ji,jj) + zts(ji,jj,jp_sal) 
     216            END DO 
     217         END DO 
    127218         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    128          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    129          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
    130          ENDIF 
    131          ! 
    132          e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
    133          ! 
    134          frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
     219         IF( ln_apr_dyn ) THEN    
     220!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     221            DO jj = 1, jpj 
     222               DO ji = 1, jpi 
     223                  ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
     224               END DO 
     225            END DO 
     226         ELSE                     
     227!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     228           DO jj = 1, jpj 
     229              DO ji = 1, jpi 
     230                 ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) 
     231              END DO 
     232           END DO 
     233         ENDIF 
     234         ! 
     235!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     236         DO jj = 1, jpj 
     237            DO ji = 1, jpi 
     238               e3t_m(ji,jj) = e3t_m(ji,jj) + e3t_n(ji,jj,1) 
     239               ! 
     240               frq_m(ji,jj) = frq_m(ji,jj) + fraqsr_1lev(ji,jj) 
     241            END DO 
     242         END DO 
    135243 
    136244         !                                                ! ---------------------------------------- ! 
     
    138246            !                                             ! ---------------------------------------- ! 
    139247            zcoef = 1. / REAL( nn_fsbc, wp ) 
    140             sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celsius] 
    141             sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
    142             ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
    143             ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
    144             ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
    145             e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
    146             frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     248!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     249            DO jj = 1, jpj 
     250               DO ji = 1, jpi 
     251                  sst_m(ji,jj) = sst_m(ji,jj) * zcoef     ! mean SST             [Celsius] 
     252                  sss_m(ji,jj) = sss_m(ji,jj) * zcoef     ! mean SSS             [psu] 
     253                  ssu_m(ji,jj) = ssu_m(ji,jj) * zcoef     ! mean suface current  [m/s] 
     254                  ssv_m(ji,jj) = ssv_m(ji,jj) * zcoef     ! 
     255                  ssh_m(ji,jj) = ssh_m(ji,jj) * zcoef     ! mean SSH             [m] 
     256                  e3t_m(ji,jj) = e3t_m(ji,jj) * zcoef     ! mean vertical scale factor [m] 
     257                  frq_m(ji,jj) = frq_m(ji,jj) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     258               END DO 
     259            END DO 
    147260            ! 
    148261         ENDIF 
     
    190303      !!---------------------------------------------------------------------- 
    191304      REAL(wp) ::   zcoef, zf_sbc   ! local scalar 
     305      INTEGER  ::   ji, jj          ! loop index 
    192306      !!---------------------------------------------------------------------- 
    193307      ! 
     
    217331               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
    218332            ELSE 
    219                frq_m(:,:) = 1._wp   ! default definition 
     333!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     334               DO jj = 1, jpj 
     335                  DO ji = 1, jpi 
     336                     frq_m(ji,jj) = 1._wp   ! default definition 
     337                  END DO 
     338               END DO 
    220339            ENDIF 
    221340            ! 
     
    223342               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc  
    224343               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
    225                ssu_m(:,:) = zcoef * ssu_m(:,:)  
    226                ssv_m(:,:) = zcoef * ssv_m(:,:) 
    227                sst_m(:,:) = zcoef * sst_m(:,:) 
    228                sss_m(:,:) = zcoef * sss_m(:,:) 
    229                ssh_m(:,:) = zcoef * ssh_m(:,:) 
    230                e3t_m(:,:) = zcoef * e3t_m(:,:) 
    231                frq_m(:,:) = zcoef * frq_m(:,:) 
     344!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     345               DO jj = 1, jpj 
     346                  DO ji = 1, jpi 
     347                     ssu_m(ji,jj) = zcoef * ssu_m(ji,jj)  
     348                     ssv_m(ji,jj) = zcoef * ssv_m(ji,jj) 
     349                     sst_m(ji,jj) = zcoef * sst_m(ji,jj) 
     350                     sss_m(ji,jj) = zcoef * sss_m(ji,jj) 
     351                     ssh_m(ji,jj) = zcoef * ssh_m(ji,jj) 
     352                     e3t_m(ji,jj) = zcoef * e3t_m(ji,jj) 
     353                     frq_m(ji,jj) = zcoef * frq_m(ji,jj) 
     354                  END DO 
     355               END DO 
    232356            ELSE 
    233357               IF(lwp) WRITE(numout,*) '   mean fields read in the ocean restart file' 
     
    239363         ! 
    240364         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
    241          ssu_m(:,:) = ub(:,:,1) 
    242          ssv_m(:,:) = vb(:,:,1) 
     365!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     366            DO jj = 1, jpj 
     367               DO ji = 1, jpi 
     368                  ssu_m(ji,jj) = ub(ji,jj,1) 
     369                  ssv_m(ji,jj) = vb(ji,jj,1) 
     370               END DO 
     371            END DO 
    243372         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    244373         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    245374         ENDIF 
    246          sss_m(:,:) = tsn  (:,:,1,jp_sal) 
    247          ssh_m(:,:) = sshn (:,:) 
    248          e3t_m(:,:) = e3t_n(:,:,1) 
    249          frq_m(:,:) = 1._wp 
     375!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     376         DO jj = 1, jpj 
     377            DO ji = 1, jpi 
     378               sss_m(ji,jj) = tsn  (ji,jj,1,jp_sal) 
     379               ssh_m(ji,jj) = sshn (ji,jj) 
     380               e3t_m(ji,jj) = e3t_n(ji,jj,1) 
     381               frq_m(ji,jj) = 1._wp 
     382            END DO 
     383         END DO 
    250384         ! 
    251385      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.