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.
mpp_optimiz_zoom_nc.f90 in branches/UKMO/dev_merge_2017_restart_datestamp_GO6_mixing/NEMOGCM/TOOLS/MPP_PREP/src – NEMO

source: branches/UKMO/dev_merge_2017_restart_datestamp_GO6_mixing/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90 @ 9496

Last change on this file since 9496 was 9496, checked in by davestorkey, 6 years ago

UKMO/branches/dev_merge_2017_restart_datestamp_GO6_mixing : clear SVN keywords.

File size: 12.3 KB
Line 
1PROGRAM mpp_optimiz_nc
2 !!---------------------------------------------------------------------
3 !!
4 !!                       PROGRAM MPP_OPTIMIZ_NC
5 !!                     ***********************
6 !!
7 !!  PURPOSE :
8 !!  ---------
9 !!              This program is build to optimize the domain beakdown into
10 !!              subdomain for mpp computing.
11 !!              Once the grid size, and the land/sea mask is known, it looks
12 !!              for all the possibilities within a range of setting parameters
13 !!              and determine the optimal.
14 !!
15 !!              Optimization is done with respect to the maximum number of
16 !!              sea processors and to the maximum numbers of procs (jprocx)
17 !!                     
18 !!              Optional optimization can be performed takink into account
19 !!              the maximum available processor memory ppmcal. This is
20 !!              activated if jpmen =1
21 !!
22 !! history:
23 !! --------
24 !!       original  : 95-12 (Imbard M) for OPA8.1, CLIPPER
25 !!       f90       : 03-06 (Molines JM), namelist as input
26 !!                 : 05-05 (Molines JM), bathy in ncdf
27 !!----------------------------------------------------------------------
28 !! * modules used
29  USE netcdf
30
31  IMPLICIT NONE
32
33  INTEGER ::  jprocx=250   !: maximum number of proc. (Read from namelist)
34  INTEGER ::  jpmem=0      !: memory constraint (1) or no constraint (0)
35     !                     !  (use 1 with caution as the memory size of
36     !                     !   the code lays on OPA 8.1 estimates ...)
37     !
38  INTEGER          ::  &
39       jpk    = 46  ,    & !: vertical levels (namelist)
40       jpiglo = 1442,    & !: I-size of the model (namelist)
41       jpjglo = 1021,    & !: J-size of the model (namelist)
42       jpidta = 1442,    & !: I-size of the data file (namelist)
43       jpjdta = 1021,   &  !: J-size of the data files (namelist)
44       nizoom = 1 ,     &  !: I zoom indicator (namelist)
45       njzoom = 1 ,     &  !: J zoom indicatori (namelist)
46       numnam = 4          !: logical unit for the namelist
47  NAMELIST /namspace/ jpk,jpiglo,jpjglo,jpidta,jpjdta,nizoom,njzoom
48  NAMELIST /namproc/ jprocx, jpmem
49
50  INTEGER ::  jpnix ,jpnjx 
51  !
52  INTEGER,PARAMETER :: jpreci=1 ,jprecj=1
53  !
54  ! Following variables are used only if jpmem=1
55  REAL(KIND=4) ::  ppmpt ,   &
56       ppmcal = 225000000., &  !: maximum memory of one processor for a given machine (in 8 byte words)
57       ppmin  = 0.4,         & !: minimum ratio to fill the memory
58       ppmax  = 0.9            !: maximum ration to fill the memory
59  ! Aleph
60  !     PARAMETER(ppmcal= 16000000.)
61  !Brodie
62  !     PARAMETER(ppmcal=250000000.)
63  ! Uqbar
64  !     PARAMETER(ppmcal=3750000000.)
65  ! Zahir
66  !     PARAMETER(ppmcal=225000000.)
67
68  CHARACTER(LEN=80) :: cbathy, &       !: File name of the netcdf bathymetry (namelist)
69      &                clvar           !: Variable name in netcdf for the bathy to be read
70  LOGICAL ::  ln_zps=.false.           !: Logical flag for partial cells.
71  NAMELIST /namfile/ cbathy, ln_zps
72  NAMELIST /namparam/ ppmcal, ppmin, ppmax
73  !
74  INTEGER :: iumout = 1
75  INTEGER :: ji,jj,jn,jni,jnj,jni2,jnj2
76  INTEGER :: iumbat,ifreq,il1,il2
77  INTEGER :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
78  INTEGER :: iilb,ijlb,ireci,irecj,in
79  INTEGER :: ipi,ipj
80  INTEGER :: inf10,inf30,inf50,iptx,isw
81  INTEGER :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
82  !
83  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
84  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
85  !
86  REAL(KIND=4)                           ::  zmin,zmax,zper,zmem
87  REAL(KIND=4)                           ::  zzmin,zzmax,zperx
88  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask ,&  ! jpiglo -jpjglo
89      &                                        zdta      ! jpidta -jpjdta
90
91 ! CDF stuff
92  INTEGER :: ncid, ivarid, istatus
93  LOGICAL ::  llbon=.false.
94  !
95  ! 0. Initialisation
96  ! -----------------
97  OPEN(numnam,FILE='namelist')
98  REWIND(numnam)
99  READ(numnam,namspace)
100
101  REWIND(numnam)
102  READ(numnam,namfile)
103
104  REWIND(numnam)
105  READ(numnam,namparam)
106
107  REWIND(numnam)
108  READ(numnam,namproc)
109
110  ! estimated  code size expressed in number of 3D arrays (valid for OPA8.1)
111  ppmpt = 55.+73./jpk
112  jpnix = jprocx ; jpnjx=jprocx
113
114  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo),zdta(jpidta,jpjdta) )
115  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
116  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
117
118  OPEN(iumout,FILE='processor.layout')
119  WRITE(iumout,*)
120  WRITE(iumout,*) ' optimisation de la partition'
121  WRITE(iumout,*) ' ----------------------------'
122  WRITE(iumout,*)
123  !
124  ! * Read cdf bathy file
125  !
126         IF ( ln_zps ) THEN        ! partial steps
127            clvar = 'Bathymetry'
128         ELSE
129            clvar = 'Bathy_level'  ! full steps
130         ENDIF
131
132         INQUIRE( FILE=cbathy, EXIST=llbon )
133      IF( llbon ) THEN
134            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
135            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
136            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
137            istatus=NF90_CLOSE(ncid)
138      ELSE
139          PRINT *,' File missing : ', trim(cbathy)
140          STOP
141      ENDIF
142  ibathy(:,:)=zdta(:,:)
143
144  !
145  ! Building the mask
146  DO jj=1,jpjglo
147     DO ji=1,jpiglo
148        zmask(ji,jj) = float(ibathy(ji+nizoom - 1,jj+njzoom -1))
149     END DO
150  END DO
151
152  DO jj=1,jpjglo
153     DO ji=1,jpiglo
154        zmask(ji,jj)=  min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))  ! Old vector coding rule ...
155     END DO
156  END DO
157  !
158  !  Main loop on processors
159  ! ------------------------
160  iii=1 ; iij=1
161  iiii=jpiglo ; iijj=jpjglo
162  iptx=0
163  iimoy=0
164  zzmin=0. ; zzmax=0.
165  iinf10=0 ; iinf30=0 ; iinf50=0
166  zperx=1.
167  in=0
168  DO jni=1,jpnix
169     DO jnj=1,jpnjx
170        !
171        ! Limitation ob the maxumun number of PE's
172        IF(jni*jnj >  jprocx) goto 1000
173        !
174        ! Partition
175        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
176        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
177        !
178        ! Memory optimization ?
179        isw=0
180        zmem=ppmpt*ipi*ipj*jpk
181        IF(zmem > ppmcal) go to 1000
182        IF(jpmem == 1) THEN
183           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
184        ENDIF
185        IF(isw.EQ.1) go to 1000
186        in=in+1
187        !
188        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
189        WRITE(iumout,*) ' '
190        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
191        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
192        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
193        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
194        !
195        ! Coin en bas a gauche de chaque processeur
196        !
197        iilb=1
198        ijlb=1
199        ireci=2*jpreci
200        irecj=2*jprecj
201        iresti = MOD ( jpiglo - ireci , jni )
202        irestj = MOD ( jpjglo - irecj , jnj )
203        !
204        IF (iresti.EQ.0) iresti = jni
205        DO jj=1,jnj
206           DO ji=1,iresti
207              ippdi(ji,jj) = ipi
208           END DO
209           DO ji=iresti+1,jni
210              ippdi(ji,jj) = ipi -1
211           END DO
212        END DO
213        IF (irestj.EQ.0) irestj = jnj
214        DO ji=1,jni
215           DO jj=1,irestj
216              ippdj(ji,jj) = ipj
217           END DO
218           DO jj=irestj+1,jnj
219              ippdj(ji,jj) = ipj -1
220           END DO
221        END DO
222        DO jj=1,jnj
223           DO ji=1,jni
224              iidom(ji,jj)=iilb
225              ijdom(ji,jj)=ijlb
226           END DO
227        END DO
228        WRITE(iumout,*) " iresti=",iresti," irestj=",irestj
229        !
230        !  2. Boucle sur les processeurs
231        ! ------------------------------
232        !
233        ivide=0
234        imoy=0
235        zmin=1.e+20
236        zmax=-1.e+20
237        inf10=0
238        inf30=0
239        inf50=0
240        !
241        DO jni2=1,jni
242           DO jnj2=1,jnj
243
244              IF(jni.GT.1)THEN
245                 DO jj=1,jnj
246                    DO ji=2,jni
247                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
248                    END DO
249                 END DO
250                 iilb=iidom(jni2,jnj2)
251              ENDIF
252              IF(jnj.GT.1)THEN
253                 DO jj=2,jnj
254                    DO ji=1,jni
255                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
256                    END DO
257                 END DO
258                 ijlb=ijdom(jni2,jnj2)
259              ENDIF
260
261              ! Check wet points over the entire domain to preserve the MPI communication stencil
262              isurf=0
263              DO jj=1,ippdj(jni2,jnj2)
264                 DO  ji=1,ippdi(jni2,jnj2)
265                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
266                 END DO
267              END DO
268
269              IF(isurf.EQ.0) THEN
270                 ivide=ivide+1
271              ELSE
272                 imoy=imoy+isurf
273              ENDIF
274              zper=float(isurf)/float(ipi*ipj)
275              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
276              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
277              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
278              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
279              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
280              !
281              !
282              ! 3. Fin de boucle sur les processeurs, impression
283              ! ------------------------------------------------
284              !
285           END DO
286        END DO
287        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
288        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
289        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
290        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
291        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
292        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
293        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
294        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
295        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10 -inf30
296        WRITE(iumout,*) ' nombre de points integres   ', (jni*jnj-ivide)*ipi*ipj
297        WRITE(iumout,*) ' nbr de pts supplementaires  ', (jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
298        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
299        WRITE(iumout,*) ' % sup                       ',zper
300        WRITE(iumout,*)
301        !
302        !
303        ! 4. Recherche de l optimum
304        ! -------------------------
305        !
306        IF(ivide.GT.iptx) THEN
307           iii=jni
308           iij=jnj
309           iiii=ipi
310           iijj=ipj
311           iptx=ivide
312           iimoy=imoy
313           zzmin=zmin
314           zzmax=zmax
315           iinf10=inf10
316           iinf30=inf30
317           iinf50=inf50
318           zperx=zper
319        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
320           iii=jni
321           iij=jnj
322           iiii=ipi
323           iijj=ipj
324           iimoy=imoy
325           zzmin=zmin
326           zzmax=zmax
327           iinf10=inf10
328           iinf30=inf30
329           iinf50=inf50
330           zperx=zper
331        ENDIF
332        !
333        ! 5. Fin de boucle sur le nombre de processeurs
334        ! ---------------------------------------------
335        !
336      1000 continue
337     END DO
338  END DO
339  !
340  !
341  ! 6. Affichage resultat
342  ! ---------------------
343  !
344  IF(in.EQ.0) THEN
345     WRITE(iumout,*) ' le choix n'' a pas pu etre fait '
346     WRITE(iumout,*)
347     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
348     STOP
349  ENDIF
350  WRITE(iumout,*) ' choix optimum'
351  WRITE(iumout,*) ' ============='
352  WRITE(iumout,*) 
353  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
354  WRITE(iumout,*) ' '
355  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
356  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
357  WRITE(iumout,*) 
358  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
359  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
360  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
361  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
362  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
363  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
364  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
365  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10 -iinf30
366  WRITE(iumout,*) ' nombre de points integres   ', (iii*iij-iptx)*iiii*iijj
367  WRITE(iumout,*) ' nbr de pts supplementaires  ', (iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
368  WRITE(iumout,*) ' % sup                       ',zperx
369  WRITE(iumout,*)
370  CLOSE(iumout)
371  !
372  !
373  !
374  STOP
375END PROGRAM mpp_optimiz_nc
Note: See TracBrowser for help on using the repository browser.