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.
maxval_bug.f90 in NEMO/branches/UKMO/BPC_miniapp/OpenMP – NEMO

source: NEMO/branches/UKMO/BPC_miniapp/OpenMP/maxval_bug.f90 @ 10838

Last change on this file since 10838 was 10838, checked in by wayne_gaudin, 5 years ago

Ticket #2197 - extracted versions added

File size: 1.1 KB
Line 
1PROGRAM main_bpc_hpg
2
3  IMPLICIT NONE
4 
5  INTEGER :: jpi, jpj, jpk
6  INTEGER :: jk,jj,ji
7 
8  REAL(8), DIMENSION(:,:,:),   ALLOCATABLE :: tmask
9  REAL(8), DIMENSION(:,:)  ,   ALLOCATABLE :: ssmask
10  REAL(8)                                  :: answer
11
12  jpi=3 ; jpj=3 ; jpk=3
13
14  ALLOCATE(ssmask(jpi,jpj),tmask(jpi,jpj,jpk))
15
16  DO jk = 1, jpk
17    DO jj = 1, jpj
18      DO ji = 1, jpi
19        tmask(ji,jj,jk)=ji+jpj*(jj-1)+jpk*jpj*(jk-1)
20      END DO
21    END DO
22  END DO
23  answer=SUM(MAXVAL( tmask(:,:,:), DIM=3 ))
24  write(0,*)
25  write(0,*)"tmask"
26  write(0,*)tmask
27  write(0,*)"Correct Answer",answer
28
29  DO jj = 1, jpj
30    DO ji = 1, jpi
31      ssmask(ji,jj)=MAXVAL(tmask(ji,jj,:), DIM=1)
32    END DO
33  END DO
34  write(0,*)"Variation 1: ssmask"
35  write(0,*)ssmask
36  write(0,*)"        Answer",SUM(ssmask)
37
38  DO ji = 1, jpi
39      ssmask(ji,:)=MAXVAL(tmask(ji,:,:), DIM=2)
40  END DO
41  write(0,*)"Variation 2: ssmask"
42  write(0,*)ssmask
43  write(0,*)"        Answer",SUM(ssmask)
44
45  ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )   
46  write(0,*)"Variation 3: ssmask"
47  write(0,*)ssmask
48  write(0,*)"        Answer",SUM(ssmask)
49
50END PROGRAM
Note: See TracBrowser for help on using the repository browser.