@@ -108,7 +108,7 @@ PROGRAM AdapGrid
108
108
! Close all files
109
109
CLOSE (16 )
110
110
111
- 9999 PRINT * , ' AdapGrid completed '
111
+ PRINT * , ' AdapGrid completed '
112
112
113
113
END PROGRAM AdapGrid
114
114
! End of main program
@@ -192,7 +192,7 @@ SUBROUTINE CellSide
192
192
WRITE (6 ,* ) " Start creating u boundary face II JJ=" , II, JJ
193
193
194
194
! ! Exclude last cell, the North Polar cell.
195
- DO 111 L= 1 , NC-1
195
+ DO L= 1 , NC-1
196
196
! ! Loop over all cells.
197
197
! DO 111 L=1, NC
198
198
i= 0
@@ -237,93 +237,91 @@ SUBROUTINE CellSide
237
237
END DO
238
238
239
239
IF (kk+ ij .gt. 2 * ICE(4 ,L) ) WRITE (6 ,* ) " Over done i-side for cell L,ij,kk=" , L, ij, kk
240
- IF (kk+ ij .ge. 2 * ICE(4 ,L) ) GOTO 111
240
+ IF (kk+ ij .ge. 2 * ICE(4 ,L) ) CYCLE
241
241
242
- IF (ij .eq. 0 ) THEN
242
+ IF (ij .eq. 0 ) THEN
243
243
! ! Full boundary cell for west side
244
- II= II+1
245
- ISD(1 ,II)= ICE(1 ,L)
246
- ISD(2 ,II)= ICE(2 ,L)
247
- ISD(3 ,II)= ICE(4 ,L)
244
+ II= II+1
245
+ ISD(1 ,II)= ICE(1 ,L)
246
+ ISD(2 ,II)= ICE(2 ,L)
247
+ ISD(3 ,II)= ICE(4 ,L)
248
248
! ! New boundary cells proportional to cell x-sizes
249
249
! ! Updated for any 2**n sizes
250
- ! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 )
251
- ISD(5 ,II)=- INT ( LOG (FLOAT(ICE(3 , L)))/ LOG (2 .) + 0.01 )
252
- ISD(6 ,II)= L
253
- ENDIF
254
- IF (kk .eq. 0 ) THEN
250
+ ! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 )
251
+ ISD(5 ,II)=- INT ( LOG (FLOAT(ICE(3 , L)))/ LOG (2 .) + 0.01 )
252
+ ISD(6 ,II)= L
253
+ ENDIF
254
+ IF (kk .eq. 0 ) THEN
255
255
! ! Full boundary cell for east side
256
- II= II+1
257
- ISD(1 ,II)= LM
258
- ISD(2 ,II)= ICE(2 ,L)
259
- ISD(3 ,II)= ICE(4 ,L)
260
- ISD(5 ,II)= L
256
+ II= II+1
257
+ ISD(1 ,II)= LM
258
+ ISD(2 ,II)= ICE(2 ,L)
259
+ ISD(3 ,II)= ICE(4 ,L)
260
+ ISD(5 ,II)= L
261
261
! ! Updated for any 2**n sizes
262
- ! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 )
263
- ISD(6 ,II)=- INT ( LOG (FLOAT(ICE(3 , L)))/ LOG (2 .) + 0.01 )
264
- ENDIF
262
+ ! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 )
263
+ ISD(6 ,II)=- INT ( LOG (FLOAT(ICE(3 , L)))/ LOG (2 .) + 0.01 )
264
+ ENDIF
265
265
266
266
! ! Half cell size west boundary faces
267
- IF (ij .gt. 0 .and. ij .lt. ICE(4 ,L) ) THEN
268
- IF ( i .eq. 0 ) THEN
267
+ IF (ij .gt. 0 .and. ij .lt. ICE(4 ,L) ) THEN
268
+ IF ( i .eq. 0 ) THEN
269
269
! ! lower half west cell face
270
- II= II+1
271
- ISD(1 ,II)= ICE(1 ,L)
272
- ISD(2 ,II)= ICE(2 ,L)
273
- ISD(3 ,II)= ICE(4 ,L)/ 2
270
+ II= II+1
271
+ ISD(1 ,II)= ICE(1 ,L)
272
+ ISD(2 ,II)= ICE(2 ,L)
273
+ ISD(3 ,II)= ICE(4 ,L)/ 2
274
274
! ! Updated for any 2**n sizes
275
- ISD(5 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
275
+ ISD(5 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
276
276
! ! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2
277
- ISD(6 ,II)= L
278
- ENDIF
279
- IF ( j .eq. 0 ) THEN
277
+ ISD(6 ,II)= L
278
+ ENDIF
279
+ IF ( j .eq. 0 ) THEN
280
280
! ! Upper half west cell face
281
- II= II+1
282
- ISD(1 ,II)= ICE(1 ,L)
283
- ISD(2 ,II)= ICE(2 ,L)+ ICE(4 ,L)/ 2
284
- ISD(3 ,II)= ICE(4 ,L)/ 2
281
+ II= II+1
282
+ ISD(1 ,II)= ICE(1 ,L)
283
+ ISD(2 ,II)= ICE(2 ,L)+ ICE(4 ,L)/ 2
284
+ ISD(3 ,II)= ICE(4 ,L)/ 2
285
285
! ! Updated for any 2**n sizes
286
- ISD(5 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
287
- ISD(6 ,II)= L
288
- ENDIF
289
- ENDIF
286
+ ISD(5 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
287
+ ISD(6 ,II)= L
288
+ ENDIF
289
+ ENDIF
290
290
291
291
! ! Half cell size east boundary faces
292
- IF (kk .gt. 0 .and. kk .lt. ICE(4 ,L) ) THEN
293
- IF ( k .eq. 0 ) THEN
292
+ IF (kk .gt. 0 .and. kk .lt. ICE(4 ,L) ) THEN
293
+ IF ( k .eq. 0 ) THEN
294
294
! ! lower half east cell face
295
- II= II+1
296
- ISD(1 ,II)= LM
297
- ISD(2 ,II)= ICE(2 ,L)
298
- ISD(3 ,II)= ICE(4 ,L)/ 2
295
+ II= II+1
296
+ ISD(1 ,II)= LM
297
+ ISD(2 ,II)= ICE(2 ,L)
298
+ ISD(3 ,II)= ICE(4 ,L)/ 2
299
299
! ! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2
300
- ISD(5 ,II)= L
300
+ ISD(5 ,II)= L
301
301
! ! Updated for any 2**n sizes
302
- ISD(6 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
303
- ENDIF
304
- IF ( n .eq. 0 ) THEN
302
+ ISD(6 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
303
+ ENDIF
304
+ IF ( n .eq. 0 ) THEN
305
305
! ! Upper half west cell face
306
- II= II+1
307
- ISD(1 ,II)= LM
308
- ISD(2 ,II)= ICE(2 ,L)+ ICE(4 ,L)/ 2
309
- ISD(3 ,II)= ICE(4 ,L)/ 2
306
+ II= II+1
307
+ ISD(1 ,II)= LM
308
+ ISD(2 ,II)= ICE(2 ,L)+ ICE(4 ,L)/ 2
309
+ ISD(3 ,II)= ICE(4 ,L)/ 2
310
310
! ! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2
311
- ISD(5 ,II)= L
311
+ ISD(5 ,II)= L
312
312
! ! Updated for any 2**n sizes
313
- ISD(6 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
314
- ENDIF
315
- ENDIF
316
-
317
- 111 CONTINUE
318
-
313
+ ISD(6 ,II)=- INT ( LOG (FLOAT(ISD(3 ,II)))/ LOG (2 .) + 0.01 )
314
+ ENDIF
315
+ ENDIF
316
+ ENDDO
319
317
320
318
! Set boundary v faces
321
319
WRITE (6 ,* ) " Start creating v boundary face II JJ=" , II, JJ
322
320
323
321
! ! Exclude the last polar cell
324
- DO 222 L= 1 , NC-1
322
+ DO L= 1 , NC-1
325
323
! ! Loop over all cells
326
- ! DO 222 L=1, NC
324
+ ! DO L=1, NC
327
325
i= 0
328
326
j= 0
329
327
ij= 0
@@ -361,97 +359,96 @@ SUBROUTINE CellSide
361
359
END DO
362
360
363
361
IF (nn+ ij .gt. 2 * ICE(3 ,L) ) WRITE (6 ,* ) " Over done j-side for L, ij, nn=" , L, ij, nn
364
- IF (nn+ ij .ge. 2 * ICE(3 ,L) ) GOTO 222
362
+ IF (nn+ ij .ge. 2 * ICE(3 ,L) ) CYCLE
365
363
366
- IF (ij .eq. 0 ) THEN
364
+ IF (ij .eq. 0 ) THEN
367
365
! ! Full boundary cell for south side
368
- JJ= JJ+1
369
- JSD(1 ,JJ)= ICE(1 ,L)
370
- JSD(2 ,JJ)= ICE(2 ,L)
371
- JSD(3 ,JJ)= ICE(3 ,L)
366
+ JJ= JJ+1
367
+ JSD(1 ,JJ)= ICE(1 ,L)
368
+ JSD(2 ,JJ)= ICE(2 ,L)
369
+ JSD(3 ,JJ)= ICE(3 ,L)
372
370
! ! New boundary cells proportional to cell sizes
373
371
! ! Updated for any 2**n sizes
374
- JSD(5 ,JJ)=- INT ( LOG (FLOAT(ICE(3 ,L)))/ LOG (2 .) + 0.01 )
375
- JSD(6 ,JJ)= L
376
- JSD(8 ,JJ)= ICE(4 ,L)
372
+ JSD(5 ,JJ)=- INT ( LOG (FLOAT(ICE(3 ,L)))/ LOG (2 .) + 0.01 )
373
+ JSD(6 ,JJ)= L
374
+ JSD(8 ,JJ)= ICE(4 ,L)
377
375
! ! No cells over Antarctic land so there is no S Polar cell.
378
- ENDIF
379
- IF (nn .eq. 0 ) THEN
376
+ ENDIF
377
+ IF (nn .eq. 0 ) THEN
380
378
! ! Full boundary cell for north side
381
- JJ= JJ+1
382
- JSD(1 ,JJ)= ICE(1 ,L)
383
- JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
384
- JSD(3 ,JJ)= ICE(3 ,L)
385
- JSD(5 ,JJ)= L
379
+ JJ= JJ+1
380
+ JSD(1 ,JJ)= ICE(1 ,L)
381
+ JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
382
+ JSD(3 ,JJ)= ICE(3 ,L)
383
+ JSD(5 ,JJ)= L
386
384
! ! North polar cell takes the whole last 4 rows above JSD=ICE(2,NC).
387
385
! ! Note ICE(2,L) represents lower-side of the cell. Polar cell is the last cell NC.
388
- IF ( ICE(2 ,L)+ ICE(4 ,L) .eq. ICE(2 ,NC) ) THEN
389
- JSD(6 ,JJ)= NC
390
- WRITE (6 ,* ) " Set north pole v face for cell L" , L
391
- ELSE
386
+ IF ( ICE(2 ,L)+ ICE(4 ,L) .eq. ICE(2 ,NC) ) THEN
387
+ JSD(6 ,JJ)= NC
388
+ WRITE (6 ,* ) " Set north pole v face for cell L" , L
389
+ ELSE
392
390
! ! Updated for any 2**n sizes
393
391
JSD(6 ,JJ)=- INT ( LOG (FLOAT(ICE(3 ,L)))/ LOG (2 .) + 0.01 )
394
- ENDIF
395
- JSD(8 ,JJ)= ICE(4 ,L)
396
- ENDIF
392
+ ENDIF
393
+ JSD(8 ,JJ)= ICE(4 ,L)
394
+ ENDIF
397
395
398
396
! ! Half cell size south boundary faces
399
- IF (ij .gt. 0 .and. ij .lt. ICE(3 ,L) ) THEN
400
- IF ( i .eq. 0 ) THEN
397
+ IF (ij .gt. 0 .and. ij .lt. ICE(3 ,L) ) THEN
398
+ IF ( i .eq. 0 ) THEN
401
399
! ! left half cell face
402
- JJ= JJ+1
403
- JSD(1 ,JJ)= ICE(1 ,L)
404
- JSD(2 ,JJ)= ICE(2 ,L)
405
- JSD(3 ,JJ)= ICE(3 ,L)/ 2
400
+ JJ= JJ+1
401
+ JSD(1 ,JJ)= ICE(1 ,L)
402
+ JSD(2 ,JJ)= ICE(2 ,L)
403
+ JSD(3 ,JJ)= ICE(3 ,L)/ 2
406
404
! ! New boundary cells proportional to cell sizes
407
405
! ! Updated for any 2**n sizes
408
- JSD(5 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
409
- JSD(6 ,JJ)= L
410
- JSD(8 ,JJ)= ICE(4 ,L)
411
- ENDIF
412
- IF ( j .eq. 0 ) THEN
406
+ JSD(5 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
407
+ JSD(6 ,JJ)= L
408
+ JSD(8 ,JJ)= ICE(4 ,L)
409
+ ENDIF
410
+ IF ( j .eq. 0 ) THEN
413
411
! ! right half cell face
414
- JJ= JJ+1
415
- JSD(1 ,JJ)= ICE(1 ,L)+ ICE(3 ,L)/ 2
416
- JSD(2 ,JJ)= ICE(2 ,L)
417
- JSD(3 ,JJ)= ICE(3 ,L)/ 2
412
+ JJ= JJ+1
413
+ JSD(1 ,JJ)= ICE(1 ,L)+ ICE(3 ,L)/ 2
414
+ JSD(2 ,JJ)= ICE(2 ,L)
415
+ JSD(3 ,JJ)= ICE(3 ,L)/ 2
418
416
! ! New boundary cells proportional to cell sizes
419
417
! ! Updated for any 2**n sizes
420
- JSD(5 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
421
- JSD(6 ,JJ)= L
422
- JSD(8 ,JJ)= ICE(4 ,L)
423
- ENDIF
424
- ENDIF
418
+ JSD(5 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
419
+ JSD(6 ,JJ)= L
420
+ JSD(8 ,JJ)= ICE(4 ,L)
421
+ ENDIF
422
+ ENDIF
425
423
426
424
! ! Half cell size north boundary faces
427
- IF (nn .gt. 0 .and. nn .lt. ICE(3 ,L) ) THEN
428
- IF ( k .eq. 0 ) THEN
425
+ IF (nn .gt. 0 .and. nn .lt. ICE(3 ,L) ) THEN
426
+ IF ( k .eq. 0 ) THEN
429
427
! ! left half north cell face
430
- JJ= JJ+1
431
- JSD(1 ,JJ)= ICE(1 ,L)
432
- JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
433
- JSD(3 ,JJ)= ICE(3 ,L)/ 2
434
- JSD(5 ,JJ)= L
428
+ JJ= JJ+1
429
+ JSD(1 ,JJ)= ICE(1 ,L)
430
+ JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
431
+ JSD(3 ,JJ)= ICE(3 ,L)/ 2
432
+ JSD(5 ,JJ)= L
435
433
! ! New boundary cells proportional to cell sizes
436
434
! ! Updated for any 2**n sizes
437
- JSD(6 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
438
- JSD(8 ,JJ)= ICE(4 ,L)
439
- ENDIF
440
- IF ( n .eq. 0 ) THEN
435
+ JSD(6 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
436
+ JSD(8 ,JJ)= ICE(4 ,L)
437
+ ENDIF
438
+ IF ( n .eq. 0 ) THEN
441
439
! ! right half north cell face
442
- JJ= JJ+1
443
- JSD(1 ,JJ)= ICE(1 ,L)+ ICE(3 ,L)/ 2
444
- JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
445
- JSD(3 ,JJ)= ICE(3 ,L)/ 2
446
- JSD(5 ,JJ)= L
440
+ JJ= JJ+1
441
+ JSD(1 ,JJ)= ICE(1 ,L)+ ICE(3 ,L)/ 2
442
+ JSD(2 ,JJ)= ICE(2 ,L)+ ICE(4 ,L)
443
+ JSD(3 ,JJ)= ICE(3 ,L)/ 2
444
+ JSD(5 ,JJ)= L
447
445
! ! New boundary cells proportional to cell sizes
448
446
! ! Updated for any 2**n sizes
449
- JSD(6 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
450
- JSD(8 ,JJ)= ICE(4 ,L)
451
- ENDIF
452
- ENDIF
453
-
454
- 222 CONTINUE
447
+ JSD(6 ,JJ)=- INT ( LOG (FLOAT(JSD(3 ,JJ)))/ LOG (2 .) + 0.01 )
448
+ JSD(8 ,JJ)= ICE(4 ,L)
449
+ ENDIF
450
+ ENDIF
451
+ ENDDO
455
452
456
453
! Store top level U V side numbers in NU NV
457
454
NU= II
@@ -633,9 +630,9 @@ SUBROUTINE CellSide
633
630
634
631
PRINT * , ' I J-Sides output done '
635
632
636
- 999 PRINT * , ' Sub CellSide ended.'
633
+ PRINT * , ' Sub CellSide ended.'
637
634
638
- RETURN
635
+ RETURN
639
636
640
637
END SUBROUTINE CellSide
641
638
0 commit comments