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.
cmcc_mppopt_showproc_nc.f90 in branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/TOOLS/MPP_PREP/src – NEMO

source: branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/TOOLS/MPP_PREP/src/cmcc_mppopt_showproc_nc.f90 @ 3399

Last change on this file since 3399 was 3399, checked in by vichi, 12 years ago

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