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

source: branches/UKMO/r8395_mix-lyr_diag/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90 @ 11290

Last change on this file since 11290 was 11290, checked in by jcastill, 5 years ago

Remove svn keywords

File size: 14.3 KB
Line 
1PROGRAM mppopt_showproc_nc
2 !!---------------------------------------------------------------------
3 !!
4 !!                       PROGRAM MPP_showproc_nc
5 !!                     ***********************
6 !!
7 !!  PURPOSE :
8 !!  ---------
9 !!              Build a ascii file (suitable for the overlay function of
10 !!              chart) holding the chosen domain decomposition, formely
11 !!              determined by mpp_opatimize_nc.
12 !!              It takes the same namelist than  mpp_optimize_nc, with
13 !!              the jpni, jpnj given in the namelist (NAMKEEP)
14 !!             
15 !!
16 !!              The output file is called from a root name in the namelist
17 !!              (covdta) with the jpni, jpnj, and jpnij added to the name.
18 !!   MODIFICATIONS:
19 !!   --------------
20 !!       original  : 95-12 (Imbard M)
21 !!       modif pour chart : 98-12 ( J.M. Molines)
22 !!             26/05/2005 : English documentation (partial ..) JMM
23 !!----------------------------------------------------------------------
24  !
25  USE netcdf
26  IMPLICIT NONE
27  !
28  INTEGER ::  jprocx=250
29  !
30  INTEGER :: jpmem=0
31  !
32  ! les dimensions du modele
33  !
34  INTEGER :: jpk,jpiglo,jpjglo, jpidta, jpjdta
35  NAMELIST /namspace/ jpk,jpiglo,jpjglo, jpidta, jpjdta,nizoom,njzoom
36  NAMELIST /namproc/ jprocx, jpmem
37
38  INTEGER :: jpni,jpnj, jpnij
39  CHARACTER(LEN=80) :: covdta, cdum
40  NAMELIST /namkeep/ jpni,jpnj,covdta
41
42  CHARACTER(LEN=80) ::  cbathy
43  LOGICAL :: ln_zps=.false.
44  NAMELIST /namfile / cbathy, ln_zps
45  !!
46  ! quelques parametres
47  !
48  INTEGER ::  jpnix,jpnjx
49  !
50  INTEGER,PARAMETER ::  jpreci=1,jprecj=1
51  !
52  ! les dimensions de la memoire du modele et du calculateur (T3E)
53  !
54  REAL(KIND=4) ::  ppmpt ,   &
55       ppmcal = 1000000000., &
56       ppmin  = 0.4,         &
57       ppmax  = 1.0
58  ! Aleph
59  !     PARAMETER(ppmcal=16000000.)
60  !Brodie
61  !     PARAMETER(ppmcal=250000000.)
62  ! Uqbar
63  !     PARAMETER(ppmcal=3750000000.)
64  ! Zahir
65  !     PARAMETER(ppmcal=1000000000.)
66  NAMELIST /namparam/ ppmcal, ppmin, ppmax
67
68
69  !
70  INTEGER,PARAMETER ::  iumout=8, numnam=4, iumbat=11
71  INTEGER           :: ji,jj,jn,jni,jnj,jni2,jnj2
72  INTEGER           ::  ifreq,il1,il2
73  INTEGER           :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
74  INTEGER           :: iilb,ijlb,ireci,irecj,in
75  INTEGER           :: ipi,ipj
76  INTEGER           :: inf10,inf30,inf50,iptx,isw
77  INTEGER           :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
78  !
79  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
80  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
81  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nlei, nldi,nlej,nldj,ICOUNT
82  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nleiv, nldiv,nlejv,nldjv
83  INTEGER           :: jjc, nizoom, njzoom
84  !
85  REAL(KIND=4) :: zmin,zmax,zper,zmem
86  REAL(KIND=4) :: zzmin,zzmax,zperx
87  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask, zdta, &   ! jpiglo -jpjglo
88                   zlamt, zphit
89  REAL(KIND=4),DIMENSION(:),ALLOCATABLE  ::  zdept   ! jpk
90  LOGICAL :: llbon, lwp=.true.
91  CHARACTER(LEN=80) ::  clvar
92  INTEGER :: numout=6, itime, ipk, istep,  inum
93  REAL(KIND=4) :: zdt, zdate0
94  ! CDF stuff
95  INTEGER :: ncid, ivarid, istatus
96
97  !
98  !
99  !
100  ! 0. Initialisation
101  ! -----------------
102  !
103  OPEN(numnam,FILE='namelist')
104
105  REWIND(numnam)
106  READ(numnam,namspace)
107  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo) ,zdta(jpidta,jpjdta))
108  ALLOCATE ( zlamt(jpidta,jpjdta), zphit(jpidta,jpjdta))
109
110  REWIND(numnam)
111  READ(numnam,namparam)
112
113  REWIND(numnam)
114  READ(numnam,namproc)
115
116  ppmpt = 55.+73./jpk
117  jpnix = jprocx ; jpnjx=jprocx
118
119  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
120  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
121  ALLOCATE (nlei(jprocx), nldi(jprocx) )
122  ALLOCATE (nlej(jprocx), nldj(jprocx) )
123! empty processors
124  ALLOCATE (nleiv(jprocx), nldiv(jprocx) )
125  ALLOCATE (nlejv(jprocx), nldjv(jprocx) )
126  ALLOCATE (ICOUNT(jprocx), zdept(jpk) )
127
128  REWIND(numnam)
129  READ(numnam,namfile) 
130
131  REWIND(numnam)
132  READ(numnam,namkeep)
133
134  WRITE(iumout,*)
135  WRITE(iumout,*) ' optimisation de la partition'
136  WRITE(iumout,*) ' ----------------------------'
137  WRITE(iumout,*)
138
139  !
140  ! Lecture de la bathymetrie
141  !
142      ! open the file
143         IF ( ln_zps ) THEN
144            clvar = 'Bathymetry'
145
146         ELSE
147            clvar = 'Bathy_level'
148         ENDIF
149
150         INQUIRE( FILE=cbathy, EXIST=llbon )
151      IF( llbon ) THEN
152            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
153            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
154            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
155            istatus=NF90_CLOSE(ncid)
156      ELSE
157          WRITE(numout,*)'    mppini_2 : unable to read the file', cbathy
158      ENDIF
159
160      ! land/sea mask over the global/zoom domain
161
162!     imask(:,:)=1
163!     WHERE ( zdta(jpizoom:jpiglo+jpizoom-1, jpjzoom:jpjglo+jpjzoom-1) == 0.e0 ) imask = 0
164      ibathy(:,:)=zdta(:,:)
165
166  DO jj=1,jpjglo
167     DO ji=1,jpiglo
168        zmask(ji,jj) = float(ibathy(ji+nizoom -1,jj+njzoom -1))
169     END DO
170  END DO
171  DO jj=1,jpjglo
172     DO ji=1,jpiglo
173        zmask(ji,jj)= min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))
174     END DO
175  END DO
176  print *,'Nombre de pts mer :', sum(zmask)
177  !
178  !
179  !  1. Boucle sur le nombre de processeurs
180  ! ---------------------------------------
181  !
182  iii=1
183  iij=1
184  iiii=jpiglo
185  iijj=jpjglo
186  iptx=0
187  iimoy=0
188  zzmin=0.
189  zzmax=0.
190  iinf10=0
191  iinf30=0
192  iinf50=0
193  zperx=1.
194  in=0
195! Next loop corresponds to just 1 case, which is the one kept from mpp_optimize.
196  DO jni=jpni,jpni
197     DO jnj=jpnj,jpnj
198        !
199        ! Limitation nombre de pe
200        !
201        IF(jni*jnj.GT.jprocx) go to 1000
202        !
203        ! Partition
204        !
205        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
206        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
207        !
208        ! Optimisation memoire ?
209        !
210        isw=0
211        zmem=ppmpt*ipi*ipj*jpk + jpiglo*jpjglo
212        IF(zmem.GT.ppmcal) go to 1000
213        IF(jpmem.EQ.1) THEN
214           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
215        ENDIF
216        IF(isw.EQ.1) go to 1000
217        in=in+1
218        !
219        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
220        WRITE(iumout,*) ' '
221        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
222        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
223        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
224        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
225        !
226        ! Coin en bas a gauche de chaque processeur
227        !
228        iilb=1
229        ijlb=1
230        ireci=2*jpreci
231        irecj=2*jprecj
232        iresti = MOD ( jpiglo - ireci , jni )
233        irestj = MOD ( jpjglo - irecj , jnj )
234        !
235        IF (iresti.EQ.0) iresti = jni
236        DO jj=1,jnj
237           DO ji=1,iresti
238              ippdi(ji,jj) = ipi
239           END DO
240           DO ji=iresti+1,jni
241              ippdi(ji,jj) = ipi -1
242           END DO
243        END DO
244        IF (irestj.EQ.0) irestj = jnj
245        DO ji=1,jni
246           DO jj=1,irestj
247              ippdj(ji,jj) = ipj
248           END DO
249           DO jj=irestj+1,jnj
250              ippdj(ji,jj) = ipj -1
251           END DO
252        END DO
253        DO jj=1,jnj
254           DO ji=1,jni
255              iidom(ji,jj)=iilb
256              ijdom(ji,jj)=ijlb
257           END DO
258        END DO
259        !
260        !  2. Boucle sur les processeurs
261        ! ------------------------------
262        !
263        ivide=0
264        imoy=0
265        zmin=1.e+20
266        zmax=-1.e+20
267        inf10=0
268        inf30=0
269        inf50=0
270        jjc=0
271        !
272        DO jni2=1,jni
273           DO jnj2=1,jnj
274
275              IF(jni.GT.1)THEN
276                 DO jj=1,jnj
277                    DO ji=2,jni
278                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
279                    END DO
280                 END DO
281                 iilb=iidom(jni2,jnj2)
282              ENDIF
283              IF(jnj.GT.1)THEN
284                 DO jj=2,jnj
285                    DO ji=1,jni
286                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
287                    END DO
288                 END DO
289                 ijlb=ijdom(jni2,jnj2)
290              ENDIF
291
292              ! Check wet points over the entire domain to preserve the MPI communication stencil
293              isurf=0
294              DO jj=1,ippdj(jni2,jnj2)
295                 DO  ji=1,ippdi(jni2,jnj2)
296                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
297                 END DO
298              END DO
299
300              IF(isurf.EQ.0) THEN
301                 ivide=ivide+1
302                 nldiv(ivide)=jpreci+iilb
303                 nleiv(ivide)=iilb+ippdi(jni2,jnj2)-1-jpreci
304                 nldjv(ivide)=jprecj+ijlb
305                 nlejv(ivide)=ijlb+ippdj(jni2,jnj2)-1-jprecj
306              ELSE
307                 imoy=imoy+isurf
308                 jjc=jjc+1
309                 icount(jjc)=isurf 
310                 nldi(jjc)=jpreci+iilb
311                 nlei(jjc)=iilb+ippdi(jni2,jnj2)-1-jpreci
312                 nldj(jjc)=jprecj+ijlb
313                 nlej(jjc)=ijlb+ippdj(jni2,jnj2)-1-jprecj
314              ENDIF
315              zper=float(isurf)/float(ipi*ipj)
316              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
317              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
318              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
319              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
320              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
321              !
322              !
323              ! 3. Fin de boucle sur les processeurs, impression
324              ! ------------------------------------------------
325              !
326           END DO
327        END DO
328        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
329        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
330        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
331        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
332        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
333        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
334        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
335        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
336        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10-inf30
337        WRITE(iumout,*) ' nombre de points integres   ',(jni*jnj-ivide)*ipi*ipj
338        WRITE(iumout,*) ' nbr de pts supplementaires  ',(jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
339        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
340        WRITE(iumout,*) ' % sup                       ',zper
341        WRITE(iumout,*)
342        WRITE(iumout,*) ' PROCESSORS WITH LESS THAN 100 WATER POINTS'
343
344        WRITE(cdum,'(a,1h-,i3.3,1hx,i3.3,1h_,i3.3)') TRIM(covdta),jpni,jpnj,jni*jnj -ivide
345        OPEN (10,file=cdum)
346        WRITE(10,'(a,i5)')'#',jni*jnj -ivide
347        DO jjc=1,jni*jnj-ivide
348           WRITE(10,'(a,i5)')'#',jjc
349           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
350           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nldj(jjc)-1+njzoom -1
351           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nlej(jjc)+1+njzoom -1
352           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nlej(jjc)+1+njzoom -1
353           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
354           WRITE(10,'(2i5)') 9999,9999 
355           IF (icount(jjc).LT.100) THEN
356              WRITE(iumout,*)' proc ji=',jjc,' water points:', icount(jjc)
357              WRITE(iumout,*) ' ji from ',nldi(jjc), ' to :',nlei(jjc)
358              WRITE(iumout,*) ' jj /  mask value for all ji'
359              DO jj=nldj(jjc),nlej(jjc)
360                 WRITE(iumout,900) jj,(INT(zmask(ji,jj)),ji=nldi(jjc),nlei(jjc))
361              ENDDO
362900           FORMAT(1x,i4,1x,9(10i1,1x))
363           ENDIF
364        ENDDO
365        WRITE(10,'(a,i5)')'# vides:',ivide
366        DO jjc=1,ivide
367           WRITE(10,'(a,i5)')'# vide ',jjc
368           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
369           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
370           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
371           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
372           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
373           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
374           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
375           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
376           WRITE(10,'(2i5)') 9999,9999
377        END DO
378
379        !
380        !
381        ! 4. Recherche de l optimum
382        ! -------------------------
383        !
384        IF(ivide.GT.iptx) THEN
385           iii=jni
386           iij=jnj
387           iiii=ipi
388           iijj=ipj
389           iptx=ivide
390           iimoy=imoy
391           zzmin=zmin
392           zzmax=zmax
393           iinf10=inf10
394           iinf30=inf30
395           iinf50=inf50
396           zperx=zper
397        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
398           iii=jni
399           iij=jnj
400           iiii=ipi
401           iijj=ipj
402           iimoy=imoy
403           zzmin=zmin
404           zzmax=zmax
405           iinf10=inf10
406           iinf30=inf30
407           iinf50=inf50
408           zperx=zper
409        ENDIF
410        !
411        ! 5. Fin de boucle sur le nombre de processeurs
412        ! ---------------------------------------------
413        !
4141000    CONTINUE
415     END DO
416  END DO
417  !
418  !
419  ! 6. Affichage resultat
420  ! ---------------------
421  !
422  IF(in.EQ.0) THEN
423     WRITE(iumout,*) ' le choix n a pas pu etre fait '
424     WRITE(iumout,*)
425     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
426     STOP
427  ENDIF
428  WRITE(iumout,*) ' choix optimum'
429  WRITE(iumout,*) ' ============='
430  WRITE(iumout,*) 
431  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
432  WRITE(iumout,*) ' '
433  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
434  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
435  WRITE(iumout,*) 
436  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
437  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
438  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
439  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
440  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
441  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
442  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
443  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10-iinf30
444  WRITE(iumout,*) ' nombre de points integres   ',(iii*iij-iptx)*iiii*iijj
445  WRITE(iumout,*) ' nbr de pts supplementaires  ',(iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
446  WRITE(iumout,*) ' % sup                       ',zperx
447  WRITE(iumout,*)
448  !
449  !
450  !
451  STOP
452END PROGRAM mppopt_showproc_nc
Note: See TracBrowser for help on using the repository browser.