source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90 @ 5445

Last change on this file since 5445 was 5445, checked in by davestorkey, 5 years ago

Clear SVN keywords from 2015/dev_r5021_UKMO1_CICE_coupling branch.

File size: 12.2 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              isurf=0
261              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
262                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
263                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
264                 END DO
265              END DO
266              IF(isurf.EQ.0) THEN
267                 ivide=ivide+1
268              ELSE
269                 imoy=imoy+isurf
270              ENDIF
271              zper=float(isurf)/float(ipi*ipj)
272              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
273              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
274              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
275              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
276              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
277              !
278              !
279              ! 3. Fin de boucle sur les processeurs, impression
280              ! ------------------------------------------------
281              !
282           END DO
283        END DO
284        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
285        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
286        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
287        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
288        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
289        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
290        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
291        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
292        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10 -inf30
293        WRITE(iumout,*) ' nombre de points integres   ', (jni*jnj-ivide)*ipi*ipj
294        WRITE(iumout,*) ' nbr de pts supplementaires  ', (jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
295        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
296        WRITE(iumout,*) ' % sup                       ',zper
297        WRITE(iumout,*)
298        !
299        !
300        ! 4. Recherche de l optimum
301        ! -------------------------
302        !
303        IF(ivide.GT.iptx) THEN
304           iii=jni
305           iij=jnj
306           iiii=ipi
307           iijj=ipj
308           iptx=ivide
309           iimoy=imoy
310           zzmin=zmin
311           zzmax=zmax
312           iinf10=inf10
313           iinf30=inf30
314           iinf50=inf50
315           zperx=zper
316        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
317           iii=jni
318           iij=jnj
319           iiii=ipi
320           iijj=ipj
321           iimoy=imoy
322           zzmin=zmin
323           zzmax=zmax
324           iinf10=inf10
325           iinf30=inf30
326           iinf50=inf50
327           zperx=zper
328        ENDIF
329        !
330        ! 5. Fin de boucle sur le nombre de processeurs
331        ! ---------------------------------------------
332        !
333      1000 continue
334     END DO
335  END DO
336  !
337  !
338  ! 6. Affichage resultat
339  ! ---------------------
340  !
341  IF(in.EQ.0) THEN
342     WRITE(iumout,*) ' le choix n'' a pas pu etre fait '
343     WRITE(iumout,*)
344     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
345     STOP
346  ENDIF
347  WRITE(iumout,*) ' choix optimum'
348  WRITE(iumout,*) ' ============='
349  WRITE(iumout,*) 
350  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
351  WRITE(iumout,*) ' '
352  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
353  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
354  WRITE(iumout,*) 
355  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
356  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
357  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
358  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
359  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
360  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
361  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
362  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10 -iinf30
363  WRITE(iumout,*) ' nombre de points integres   ', (iii*iij-iptx)*iiii*iijj
364  WRITE(iumout,*) ' nbr de pts supplementaires  ', (iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
365  WRITE(iumout,*) ' % sup                       ',zperx
366  WRITE(iumout,*)
367  CLOSE(iumout)
368  !
369  !
370  !
371  STOP
372END PROGRAM mpp_optimiz_nc
Note: See TracBrowser for help on using the repository browser.