-
Notifications
You must be signed in to change notification settings - Fork 0
/
swanmain.ftn
8269 lines (8175 loc) · 377 KB
/
swanmain.ftn
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!
! SWAN main program and miscellaneous routines
!
! Contents of this file:
!
! SWAN: Main program
! SWMAIN: Calling SWINIT, SWREAD, SWCOMP and SWOUTP
! SWINIT: Initialize several variables and arrays
! SWPREP: Do some preparations before computation is started
! SPRCON: Execution of some tests on the given model description
! SWRBC
! SVALQI
! SINUPT
! SINBTG
! SINCMP
! WRTEST
! ERRCHK
! SNEXTI
! RBFILE: Read boundary spectra from one file 40.00
! RESPEC: Read one 1-d OR 2-d boundary spectrum from file, and 40.00
! transform to internal SWAN spectral resolution 40.00
! FLFILE: Update boundary conditions, update nonstationary input 40.00
! fields 40.00
! SWINCO
! SWCLME: Clean memory
!
!***********************************************************************
! *
!NADC!NCOH PROGRAM SWAN
!ADC SUBROUTINE SWAN
! *
!***********************************************************************
!
!PUN USE MESSENGER 40.95
IMPLICIT NONE
!
!
! --|-----------------------------------------------------------|--
! | Delft University of Technology |
! | Faculty of Civil Engineering |
! | Environmental Fluid Mechanics Section |
! | P.O. Box 5048, 2600 GA Delft, The Netherlands |
! | |
! | Programmers: The SWAN team |
! --|-----------------------------------------------------------|--
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2016 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
! 0. Authors
!
! 30.72: IJsbrand Haagsma
! 30.74: IJsbrand Haagsma (Include version)
! 30.90: IJsbrand Haagsma (Equivalence version)
! 32.01: Roeland Ris & Cor van der Schelde
! 34.01: Jeroen Adema
! 40.30: Marcel Zijlema
! 40.31: Marcel Zijlema
! 40.41: Marcel Zijlema
! 40.95: Marcel Zijlema
!
! 1. Updates
!
! Jan. 94: transition from old pool to new pool structure
! 30.72, Sept 97: INTEGER*4 replaced by INTEGER
! 30.74, Nov. 97: Prepared for version with INCLUDE statements
! 32.01, Jan. 98: Array WL initialised (project h3268)
! 30.90, Oct. 98: Introduced EQUIVALENCE POOL-arrays
! 34.01, Feb. 99: Introducing STPNOW
! 40.30, Jan. 03: introduction distributed-memory approach using MPI
! 40.31, Dec. 03: removing POOL mechanism and reconsidering
! this main program
! 40.41, Oct. 04: common blocks replaced by modules, include files removed
! 40.95, Jun. 08: parallelization of unSWAN using MESSENGER of ADCIRC
!
! 2. Purpose
!
! Main program
!
! 8. Subroutines used
!
! SWEXITMPI 40.30
! SWINITMPI 40.30
! SWMAIN
!
LOGICAL STPNOW 40.30 34.01
!
! 11. Remarks
!
! In case of coupling with ADCIRC, this program will not be executed 41.20
! Instead, SWAN initialization and run will be done by PADCSWAN_INIT 41.20
! and PADCSWAN_RUN, respectively, as they will pass a time step to 41.20
! routine SWMAIN. See couple2swan.F 41.20
!
! 13. Source Code
!
! --- initialize the MPI execution environment 40.30
CALL SWINITMPI 40.30
IF (STPNOW()) GOTO 999 40.30
!PUN CALL MSG_INIT() 40.95
! --- start SWAN run
! the main SWAN routine is called from the ADCIRC driver
!NADC CALL SWMAIN 40.31 34.01
999 CONTINUE
! --- stop MPI 40.30
CALL SWEXITMPI 40.30
!PUN CALL MSG_FINI() 40.95
!
! --- end of MAIN PROGRAM
!
END
!***********************************************************************
! *
!NADC SUBROUTINE SWMAIN 40.31 34.01
!ADC SUBROUTINE SWMAIN ( ITIME, IT ) 41.20 40.31 34.01
! *
!***********************************************************************
!
USE TIMECOMM 40.41
USE OCPCOMM2 40.41
USE OCPCOMM4 40.41
USE SWCOMM1 40.41
USE SWCOMM2 40.41
USE SWCOMM3 40.41
USE SWCOMM4 40.41
USE OUTP_DATA 40.51
USE M_GENARR 40.31
USE M_PARALL 40.31
USE SwanGriddata 40.80
!PUN USE MESSENGER 40.95
!ADC USE Couple2Adcirc 41.20
!ADC USE Couple2Swan, ONLY: ComputeRadiationStresses, 41.20
!ADC & CouplingInterval,
!ADC & SwanOutput
!ADC & ,WriteSwanHotStart
!ADC USE GLOBAL, ONLY: ADCIRC_DTDP => DTDP, 41.20
!ADC & ADCIRC_STATIM => STATIM
!
IMPLICIT NONE
!
!
! --|-----------------------------------------------------------|--
! | Delft University of Technology |
! | Faculty of Civil Engineering |
! | Environmental Fluid Mechanics Section |
! | P.O. Box 5048, 2600 GA Delft, The Netherlands |
! | |
! | Programmers: The SWAN team |
! --|-----------------------------------------------------------|--
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2016 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
! 0. Authors
!
! 30.60: Nico Booij
! 30.72: IJsbrand Haagsma
! 30.74: IJsbrand Haagsma (Include version)
! 30.82: IJsbrand Haagsma
! 30.90: IJsbrand Haagsma (Equivalence verion)
! 32.01: Roeland Ris & Cor van der Schelde
! 32.02: Roeland Ris & Cor van der Schelde (1D-version)
! 34.01: IJsbrand Haagsma
! 40.00, 40.13: Nico Booij
! 34.01: Jeroen Adema
! 33.08: W. Erick Rogers
! 40.22: John Cazes and Tim Campbell
! 40.23: Marcel Zijlema
! 40.30: Marcel Zijlema
! 40.31: Marcel Zijlema
! 40.41: Marcel Zijlema
! 40.51: Marcel Zijlema
! 40.80: Marcel Zijlema
! 40.95: Marcel Zijlema
! 41.20: Casey Dietrich
! 41.36: Marcel Zijlema
!
! 1. Updates
!
! 10 FEB Subroutine SWMAIN introduced
! 30.60, Aug. 97: argument list of ERRCHK changed
! 30.72, Sept 97: INTEGER*4 replaced by INTEGER
! 30.72, Nov. 97: declaration of ITERMX removed because it is a common
! variable, which is declared in the INCLUDE file
! 30.72, Nov. 97: PWTAIL(3) is made dependent on PWTAIL(1), also in the
! initialisation
! 30.74, Nov. 97: Prepared for version with INCLUDE statements
! 32.01, Jan. 98: Nautical convention included (project h3268)
! 32.01, Jan. 98: Comparison of computed and prescribed significant
! wave height (project h3268)
! 32.02, Jan. 98: Introduction of 1D-version
! 30.72, Mar. 98: Added instruction to change [maxerr] in case of a
! terminating warning
! 40.00, Nov. 97: time step loop reorganized,
! argument list in call SNEXTI changed
! declaration of ITERMX removed
! argument added in call SWOUTP
! 30.82, Sep. 98: Added check on error level each time step to prevent
! continuation of computation
! 30.90, Oct. 98: Introduced EQUIVALENCE POOL-arrays
! 34.01, Feb. 99: Changed STOP statement in a jump to end of subroutine
! 34.01, Feb. 99: Close all files at end of this subroutine
! 34.01, Feb. 99: Introducing STPNOW
! 33.08, July 98: S&L scheme-related changes
! 40.13, July 01: coefficient PTRIAD(4) added
! make file 'norm_end' if program ends normally
! 40.22, Oct. 01: call SWCOMP changed in view of parallellization
! 40.23, Aug. 02: Print of CPU times added
! 40.30, Mar. 03: introduction distributed-memory approach using MPI
! 40.31, Dec. 03: removing POOL mechanism and reconsidering this
! subroutine
! 40.41, Oct. 04: common blocks replaced by modules, include files removed
! 40.51, Feb. 05: re-design output process in parallel mode
! 40.80, Jun. 07: extension to unstructured grids
! 40.95, Jun. 08: parallelization of unSWAN using MESSENGER of ADCIRC
! 41.20, Mar. 10: extension to tightly coupled ADCIRC+SWAN model
! 41.36, Jun. 12: collecting data for PunSWAN
!
! 2. Purpose
!
! SWMAIN subroutine, calling SWINIT, SWREAD, SWCOMP and SWOUTP
!
! 3. Method
!
! ---
!
! 4. Argument variables
!ADC!
!ADC INTEGER IT, ITIME 41.20
!
! 6. Local variables
!
! AC1 : Contains action density at previous time step 40.31
! BGRIDP: data concerning boundary grid points 40.31
! BLKND : array giving node number per subdomain 40.41
! BLKNDC: auxiliary array for collecting the array BLKND 40.41
! BSPECS: array containing boundary spectra 40.31
! CHARS : array to pass character info to MSGERR 40.41
! COMPDA: array containing various data depending on grid 40.31
! CROSS : integer array indicating obstacle crossing 40.30
! (0=no, >0=yes) 40.30
! ILEN : length of array 40.30
! INERR : number of the initialisation error 40.31
! OURQT : array indicating at what time requested output 40.51
! is processed 40.51
! IUNIT : counter for file unit numbers 34.01
! LOPEN : indicates whether a file is open 34.01
! MSGSTR: string to pass message to call MSGERR 40.41
!
!NADC INTEGER IUNIT 34.01
!NADC INTEGER IOSTAT, IT0, IT, SAVITE, ILEN 40.30
!NADC INTEGER INERR 40.31
!NADC INTEGER ISTAT, IF1, IL1 40.41
!NADC CHARACTER COMPUT *4, DTTIWR*18 40.00
!NADC CHARACTER*20 NUMSTR, CHARS(1) 40.41
!NADC CHARACTER*80 MSGSTR 40.41
!NADC LOGICAL LOPEN 34.01
!ADC! some variables and arrays have been moved to the 41.20
!ADC! Couple2Adcirc module so that they will persist in memory 41.20
!ADC CHARACTER DTTIWR*18 41.20
!ADC CHARACTER*20 NUMSTR 41.20
!NADC
!NADC INTEGER, ALLOCATABLE :: CROSS(:) 40.80 40.31
!NADC INTEGER, ALLOCATABLE :: BGRIDP(:) 40.31
!NADC REAL , ALLOCATABLE :: BSPECS(:,:,:,:) 40.31
!NADC REAL , ALLOCATABLE :: AC1(:,:,:), COMPDA(:,:) 40.31
!NADC!
!NADC REAL, ALLOCATABLE :: BLKND(:), BLKNDC(:), OURQT(:) 40.51 40.41
!
! 7. Common blocks used
!
!
! 8. Subroutines used
!
! SWINIT
! SWREAD
! FOR
! SWPREP
! ERRCHK
! SWRBC
! SWINCO
! SWCOLOUT 40.30
! SWGATHER 40.30
! SWSYNC 40.30
! SWCOLLECT Collects geographical field array from all nodes 40.41
! SNEXTI
! SWCOMP
! HSOBND: Generates warning if comp. and prescr. Hs differ more than 32.01
! a fraction HSRERR at the up-wave boundary 32.01
! SWOUTP
!TIMG! SWPRTI 40.23
!TIMG! SWTSTA 40.23
!TIMG! SWTSTO 40.23
! MSGERR : Handles error messages according to severity 40.41
! NUMSTR : Converts integer/real to string 40.41
! TXPBLA : Removes leading and trailing blanks in string 40.41
!
LOGICAL STPNOW 34.01
!
! 9. Subroutines calling
!
! MAIN program SWAN
!
! 10. Error Messages
!
! ---
!
! 11. Remarks
!
! The description of the structure of this subroutine is very
! short as most of the source code can easily be understood with
! the aid of the command descriptions in the user manual and the
! purpose of the subroutines from the system documentation.
!
! 12. Structure
!
! ----------------------------------------------------------------
! Call SWINIT to initialize various common data
! Repeat 40.00
! Call SWREAD to read and process user commands
! If last command was STOP
! Then exit from repeat
! -------------------------------------------------------------
! Call SWPREP to check input and prepare computation
! If nonstationary computation is to be made 40.00
! Then start time step loop at IT=0 and 40.00
! Call SWINCO to calculate initial wave spectra 40.00
! -------------------------------------------------------------
! For requested number of time steps do 40.00
! Call SNEXTI to update boundary conditions and input fields 40.00
! If IT>0 40.00
! Then Call SWCOMP to calculate the wave field 40.00
! ---------------------------------------------------------
! Call SWOUTP to postprocess the results and create output
! Update time
! ----------------------------------------------------------------
!
! 13. Source text
!ADC!
!ADC! --- do the initialization for coupled ADCIRC+SWAN model 41.20
!ADC IF ( IT.EQ.0 ) THEN
!
! --- initialize various data
!TIMG
!TIMG DCUMTM(:,1:2) = 0D0 40.23
!TIMG NCUMTM(:) = 0 40.23
!TIMG CALL SWTSTA(1) 40.23
LEVERR=0 40.23
MAXERR=1 34.01
ITRACE=0 40.23
INERR =0 40.31
ISTAT =0
!TIMG CALL SWTSTA(2) 40.23
CALL SWINIT (INERR) 40.31 34.01
!PUN IF ( MNPROC>1 ) THEN 40.95
!PUN CALL SwanReadfort18 40.95
!PUN!NADC CALL MSG_TABLE() 40.95
!PUN!NADC CALL MSG_START() 40.95
!PUN ENDIF 40.95
!TIMG CALL SWTSTO(2) 40.23
IF (INERR.GT.0) RETURN 34.01
IF (STPNOW()) RETURN 34.01
!
COMPUT = ' '
! --- repeat
!NADC DO
! --- read and process user commands
!TIMG CALL SWTSTA(3) 40.23
CALL SWREAD (COMPUT) 40.31 30.90
!TIMG CALL SWTSTO(3) 40.23
IF (STPNOW()) RETURN 34.01
! --- if last command was STOP then exit from repeat
IF (COMPUT.EQ.'STOP') THEN 40.13
IUNIT = 0 40.13
IOSTAT = 0 40.13
FILENM = 'norm_end' 40.13
CALL FOR (IUNIT, FILENM, 'UF', IOSTAT) 40.13
WRITE (IUNIT, *) ' Normal end of run ', PROJNR 40.13
GOTO 900 40.13
ENDIF 40.13
! --- allocate some arrays meant for computation 40.31
IF (NUMOBS .GT. 0) THEN
IF (OPTG.NE.5) THEN 40.80
! structured grid 40.80
ILEN = 2*MCGRD 40.80
ELSE 40.80
! unstructured grid 40.80
ILEN = nfaces 40.80
ENDIF 40.80
IF (.NOT.ALLOCATED(CROSS)) ALLOCATE(CROSS(ILEN)) 40.80 40.31
ELSE
IF (.NOT.ALLOCATED(CROSS)) ALLOCATE(CROSS(0)) 40.80 40.31
ENDIF 34.01
IF (.NOT.ALLOCATED(BSPECS)) ALLOCATE(BSPECS(MDC,MSC,NBSPEC,2)) 40.31
IF (.NOT.ALLOCATED(BGRIDP)) ALLOCATE(BGRIDP(6*NBGRPT)) 40.31
! --- do some preparations before computation 40.31
!TIMG CALL SWTSTA(4) 40.23
CALL SWPREP ( BSPECS, BGRIDP, CROSS , XCGRID, YCGRID, KGRPNT, 40.31
& KGRBND, SPCDIR, SPCSIG ) 40.31
IF (OPTG.EQ.5) CALL SwanPrepComp ( CROSS ) 40.80
IF (STPNOW()) RETURN 40.80
!TIMG CALL SWTSTO(4) 40.23
! --- check all possible flags and if necessary change
! if option is not correct
CALL ERRCHK 30.60
IF (STPNOW()) RETURN 34.01
! --- initialisation of necessary grids for depth,
! current, wind and friction
IF (ALOCMP.AND.ALLOCATED(COMPDA)) DEALLOCATE(COMPDA) 40.97
IF (.NOT.ALLOCATED(COMPDA)) THEN 40.97
ALLOCATE(COMPDA(MCGRD,MCMVAR),STAT=ISTAT) 40.97 40.41 40.31
ALOCMP = .FALSE. 40.97
END IF 40.97
IF ( ISTAT.NE.0 ) THEN 40.41
CHARS(1) = NUMSTR(ISTAT,RNAN,'(I6)') 40.41
CALL TXPBLA(CHARS(1),IF1,IL1) 40.41
MSGSTR = 40.41
& 'Allocation problem: array COMPDA and return code is '// 40.41
& CHARS(1)(IF1:IL1) 40.41
CALL MSGERR ( 4, MSGSTR ) 40.41
RETURN 40.41
END IF 40.41
!TIMG CALL SWTSTA(5) 40.23
CALL SWRBC(COMPDA) 40.31
!TIMG CALL SWTSTO(5) 40.23
! --- allocate AC1 in case of non-stationary situation or in case 40.31
! of using the S&L scheme 40.31
IF ( NSTATM.EQ.1 .AND. MXITNS.GT.1 .OR. PROPSC.EQ.3 ) THEN 40.31
IF (.NOT.ALLOCATED(AC1)) THEN 40.41 40.31
ALLOCATE(AC1(MDC,MSC,MCGRD),STAT=ISTAT) 40.41
ELSE IF (SIZE(AC1).EQ.0) THEN 40.41
DEALLOCATE(AC1) 40.41
ALLOCATE(AC1(MDC,MSC,MCGRD),STAT=ISTAT) 40.41
END IF 40.41
IF ( ISTAT.NE.0 ) THEN 40.41
CHARS(1) = NUMSTR(ISTAT,RNAN,'(I6)') 40.41
CALL TXPBLA(CHARS(1),IF1,IL1) 40.41
MSGSTR = 40.41
& 'Allocation problem: array AC1 and return code is '// 40.41
& CHARS(1)(IF1:IL1) 40.41
CALL MSGERR ( 4, MSGSTR ) 40.41
RETURN 40.41
END IF 40.41
AC1 = 0. 40.31
ELSE 40.31
IF(.NOT.ALLOCATED(AC1)) ALLOCATE(AC1(0,0,0)) 40.31
ENDIF
IF (LEVERR.GT.MAXERR) THEN 40.00
WRITE (PRINTF, 6010) LEVERR
IF (LEVERR.LT.4) WRITE (PRINTF, 6011) 30.72
6010 FORMAT(' ** No start of computation because of error level:'
& ,I3)
6011 FORMAT(' ** To ignore this error, change [maxerr] with the', 30.72
& ' SET command') 30.72
ELSE
!
IF (ITEST.GE.40) THEN 40.00
IF (NSTATC.EQ.1) THEN 33.08
WRITE (PRINTF, '(" Type of computation: dynamic")') 32.02
ELSE 32.02
IF (ONED) THEN 32.02
WRITE (PRINTF, '(" Type of computation: static 1-D")') 32.02
ELSE 32.02
WRITE (PRINTF, '(" Type of computation: static 2-D")') 32.02
ENDIF 32.02
ENDIF 32.02
ENDIF
!
IF (NSTATC.EQ.1) THEN 40.00
IT0 = 0 40.00
IF (ICOND.EQ.1) THEN 40.00
!
! --- compute default initial conditions
!
!TIMG CALL SWTSTA(6) 40.23
CALL SWINCO ( AC2 , COMPDA, XCGRID, YCGRID, 40.31
& KGRPNT, SPCDIR, SPCSIG, XYTST ) 40.31
!TIMG CALL SWTSTO(6) 40.23
!
! --- reset ICOND to prevent second computation of
! initial condition
ICOND = 0 40.00
ENDIF
ELSE
IT0 = 1
ENDIF
!ADC
!ADC! --- end the LEVERR.GT.MAXERR IF statement 41.20
!ADC ENDIF
!ADC!
!ADC! --- end the initialization for coupled ADCIRC+SWAN 41.20
!ADC ENDIF
!ADC!
!ADC! --- re-open the error IF statement 41.20
!ADC IF (LEVERR.LE.MAXERR) THEN
! --- synchronize nodes 40.30
CALL SWSYNC 40.30
IF (STPNOW()) RETURN 40.30
! --- loop over time steps 40.00
!ADC! time stepping in the coupled model is handled elsewhere 41.20
!NADC DO 500 IT = IT0, MTC 40.00
!
IF (LEVERR.GT.MAXERR) THEN 30.82
WRITE (PRINTF, 6030) LEVERR 30.82
IF (LEVERR.LT.4) WRITE (PRINTF, 6011) 40.30 30.82
6030 FORMAT(' ** No continuation of computation because ', 30.82
& 'of error level:',I3) 30.82
!NADC EXIT 40.30
!ADC RETURN 41.20
ENDIF 30.82
! --- synchronize nodes
CALL SWSYNC 40.30
IF (STPNOW()) RETURN 40.30
!
! --- update boundary conditions and input fields
!
!TIMG CALL SWTSTA(7) 40.23
CALL SNEXTI ( BSPECS, BGRIDP, COMPDA, AC1 , AC2 , 40.31
& SPCSIG, SPCDIR, XCGRID, YCGRID, KGRPNT, 40.31
& XYTST , DEPTH , WLEVL , FRIC , UXB , 40.31
& UYB , NPLAF , TURBF , MUDLF , WXI , 40.59 40.35 40.55 40.31
& WYI )
!TIMG CALL SWTSTO(7) 40.23
IF (STPNOW()) RETURN 34.01
!
! --- synchronize nodes
CALL SWSYNC 40.30
IF (STPNOW()) RETURN 40.30
IF (COMPUT.NE.'NOCO' .AND. IT.GT.0) THEN 40.00
SAVITE = ITEST 30.21
IF (ICOTES .GT. ITEST) ITEST = ICOTES
!
! --- compute action density for current time step
!
!TIMG CALL SWTSTA(8) 40.23
IF (OPTG.NE.5) THEN 40.80
! structured grid 40.80
CALL SWCOMP( AC1 , AC2 , COMPDA, SPCDIR, SPCSIG, 40.31
& XYTST , IT , KGRPNT, XCGRID, YCGRID, 40.31
& CROSS ) 40.31
ELSE 40.80
! unstructured grid 40.80
CALL SwanCompUnstruc ( AC2 , AC1 , COMPDA, 40.80
& SPCSIG, SPCDIR, XYTST , 40.80
& CROSS , IT ) 40.80
ENDIF 40.80
!TIMG CALL SWTSTO(8) 40.23
IF (STPNOW()) RETURN 34.01
!
! --- set ICOND=4 for stationary computation, for next
! (stationary) COMPUTE command 40.13
ICOND = 4 40.13
!
! --- check whether computed significant wave height at 32.01
! boundary differs from prescribed value given in 32.01
! boundary command values of incident Hs 32.01
!
IF ( BNDCHK ) THEN 32.01
CALL HSOBND ( AC2, SPCSIG, COMPDA(1,JHSIBC), KGRPNT ) 40.31
ENDIF 32.01
!
ITEST = SAVITE 30.21
ENDIF
!
IF ( IT.EQ.IT0 .AND. .NOT.ALLOCATED(OURQT) ) THEN 40.51 40.31
ALLOCATE (OURQT(MAX_OUTP_REQ)) 40.51 40.30
OURQT = -9999. 40.51 40.30
ENDIF 40.00
!
SAVITE = ITEST 30.21
IF (IOUTES .GT. ITEST) ITEST = IOUTES
!ADC
!ADC! --- perform output of SWAN quantities 41.20
!ADC CALL SwanOutput ( ITIME, IT )
!ADC! --- write the SWAN hot-start file, if necessary 41.20
!ADC IF ( WriteSwanHotStart ) THEN
!ADC CALL BACKUP ( AC2,SPCSIG,SPCDIR,KGRPNT,XCGRID,YCGRID )
!ADC WriteSwanHotStart = .FALSE.
!ADC ENDIF
! --- synchronize nodes
CALL SWSYNC 40.30
IF (STPNOW()) RETURN 40.30
! --- carry out the output requests
!TIMG CALL SWTSTA(9) 40.30
CALL SWOUTP ( AC2 , SPCSIG, SPCDIR, COMPDA, XYTST , 40.31
& KGRPNT, XCGRID, YCGRID, OURQT ) 40.51 40.31
!TIMG CALL SWTSTO(9) 40.30
IF (STPNOW()) RETURN 40.30
!
IF (ERRPTS.GT.0) REWIND(ERRPTS) 30.50
ITEST = SAVITE 30.21
! --- update time
IF (NSTATC.EQ.1) THEN 40.00
IF (IT.LT.MTC) THEN
TIMCO = TIMCO + DT 40.00
CHTIME = DTTIWR(ITMOPT, TIMCO) 40.00
WRITE (PRINTF, 222) CHTIME, TIMCO 40.00
ENDIF
222 FORMAT(' Time of computation -> ',A,' in sec:', F12.0) 40.00
ENDIF 40.00
!NADC 500 CONTINUE
IF (LEVERR.GT.MAXERR) GOTO 900 40.30
END IF
!NADC END DO
!
900 CONTINUE
!ADC!
!ADC! --- make sure that radiation stresses are up-to-date 41.20
!ADC IF ( IT.NE.MTC ) THEN
!ADC CALL ComputeRadiationStresses ( AC2, SPCDIR, SPCSIG )
!ADC ENDIF
!
!TIMG CALL SWTSTO(1) 40.23
!ADC!
!ADC IF ( IT.EQ.MTC ) THEN 41.20
!
DO IUNIT=1,HIOPEN 34.01
INQUIRE(UNIT=IUNIT,OPENED=LOPEN) 34.01
IF (LOPEN.AND.IUNIT.NE.PRINTF) CLOSE(IUNIT) 40.30
END DO 34.01
! --- collect contents of individual process files for 40.30
! output requests in case of parallel computation 40.30
CALL SWSYNC 40.30
!TIMG CALL SWTSTA(9) 40.30
IF ( PARLL ) THEN 40.30
ALLOCATE (BLKND(MXC*MYC)) 40.51 40.41
BLKND = REAL(INODE) 40.41
IF ( IAMMASTER ) THEN 40.95
ALLOCATE(BLKNDC(MXCGL*MYCGL)) 40.51 40.41
BLKNDC = 0. 40.96
END IF
CALL SWCOLLECT ( BLKNDC, BLKND, .TRUE. ) 40.51 40.41
IF (STPNOW()) RETURN 40.41
IF ( IAMMASTER ) THEN 40.95 40.30
CALL SWCOLOUT ( OURQT, BLKNDC ) 40.51 40.41 40.30
DEALLOCATE(BLKNDC) 40.41 40.30
END IF 40.30
END IF 40.30
!PUN !
!PUN IF ( MNPROC>1 ) THEN 41.36
!PUN IF ( IAMMASTER ) THEN 41.36
!PUN ALLOCATE(BLKNDC(nvertsg)) 41.36
!PUN BLKNDC = 0. 41.36
!PUN ENDIF 41.36
!PUN CALL SwanPunCollect ( BLKNDC ) 41.36
!PUN IF (STPNOW()) RETURN 41.36
!PUN IF ( IAMMASTER ) THEN 41.36
!PUN CALL SWCOLOUT ( OURQT, BLKNDC ) 41.36
!PUN DEALLOCATE(BLKNDC) 41.36
!PUN ENDIF 41.36
!PUN ENDIF 41.36
!TIMG CALL SWTSTO(9) 40.30
!
!TIMG CALL SWPRTI 40.23
!
INQUIRE(UNIT=PRINTF,OPENED=LOPEN) 40.30
IF (LOPEN) CLOSE(PRINTF) 40.30
!
! --- deallocate all allocated arrays 40.31
IF (ALLOCATED(AC1 )) DEALLOCATE(AC1 ) 40.31
IF (ALLOCATED(BGRIDP)) DEALLOCATE(BGRIDP) 40.31
IF (ALLOCATED(BSPECS)) DEALLOCATE(BSPECS) 40.31
IF (ALLOCATED(COMPDA)) DEALLOCATE(COMPDA) 40.31
IF (ALLOCATED(CROSS )) DEALLOCATE(CROSS ) 40.31
IF (ALLOCATED(OURQT )) DEALLOCATE(OURQT ) 40.51 40.30
IF (ALLOCATED(BLKND )) DEALLOCATE(BLKND ) 40.41
CALL SWCLME 40.31
!ADC!
!ADC ENDIF 41.20
!
RETURN 30.82
! end of subroutine SWMAIN
END
!***********************************************************************
! *
SUBROUTINE SWINIT (INERR) 40.31 34.01
! *
!***********************************************************************
USE OCPCOMM1 40.41
USE OCPCOMM2 40.41
USE OCPCOMM3 40.41
USE OCPCOMM4 40.41
USE SWCOMM1 40.41
USE SWCOMM2 40.41
USE SWCOMM3 40.41
USE SWCOMM4 40.41
USE TIMECOMM 40.41
USE M_SNL4 40.17
USE M_BNDSPEC 40.31
USE M_PARALL 40.31
USE SwanGriddata 40.80
!
!
! --|-----------------------------------------------------------|--
! | Delft University of Technology |
! | Faculty of Civil Engineering |
! | Environmental Fluid Mechanics Section |
! | P.O. Box 5048, 2600 GA Delft, The Netherlands |
! | |
! | Programmers: The SWAN team |
! --|-----------------------------------------------------------|--
!
!
! SWAN (Simulating WAves Nearshore); a third generation wave model
! Copyright (C) 1993-2016 Delft University of Technology
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of
! the License, or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! A copy of the GNU General Public License is available at
! http://www.gnu.org/copyleft/gpl.html#SEC3
! or by writing to the Free Software Foundation, Inc.,
! 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
!
!
! 0. Authors
!
! 30.60: Nico Booij
! 30.62: IJsbrand Haagsma
! 30.72: IJsbrand Haagsma
! 30.80: Nico Booij
! 32.01: Roeland Ris & Cor van der Schelde
! 32.02: Roeland Ris & Cor van der Schelde (1D-version)
! 32.06: Roeland Ris
! 33.08: Nico Booij and Erick Rogers (changes re: the S&L scheme)
! 33.09: Nico Booij (changes re: spherical coordinates)
! 33.10: Nico Booij and Erick Rogers (changes re: the SORDUP scheme)
! 34.01: Jeroen Adema
! 40.00: Nico Booij
! 40.02: IJsbrand Haagsma
! 40.13: Nico Booij
! 40.14: Annette Kieftenburg
! 40.16: IJsbrand Haagsma
! 40.17: IJsbrand Haagsma
! 40.21: Agnieszka Herman
! 40.23: Marcel Zijlema
! 40.30: Marcel Zijlema
! 40.31: Marcel Zijlema
! 40.41: Marcel Zijlema
! 40.51: Marcel Zijlema
! 40.61: Marcel Zijlema
! 40.64: Marcel Zijlema
! 40.80: Marcel Zijlema
! 41.13: Nico Booij
! 41.62: Andre van der Westhuysen
!
! 1. Updates
!
! 10.09, Aug. 94: PER now absolute period, RPER relative period
! 10.10, Aug. 94: arrays NE and NED added (subarrays of OUTDA)
! 20.62, Oct. 95: argument of DPBLDP made variable
! 30.60, July 97: initialisation of array EXCVAL
! 30.60, Aug. 97: initialisation of MCGRD
! 30.62, Aug. 97: initialisation of PSURF(3) (gamd=1. for HISWA)
! 30.72, Sept 97: INTEGER*4 replaced by INTEGER
! 30.72, Nov. 97: updated units in OVUNIT
! 30.72, Jan. 98: made default values for quadruplets and PNUMS(20)
! (=GRWMX) according the command GEN3 KOM
! 32.01, Jan. 98: Initialised BNAUT, BNDCHK and HSRERR
! 32.02, Jan. 98: Initialised output variable 'Setup', LSETUP, JSETUP,
! JDPSAV and ONED
! 32.01, Jan. 98: added pointers in the POOL for auxiliary arrays
! JAUX(5:7)
! 30.72, Mar. 98: Initialisation for UNDFLW added
! 30.70, Mar. 98: pool array CROSS initialized as data array (not pointer)
! 40.00, June 98: data for nonstat. boundary conditions initialised
! STATUS is renamed IERR, because STATUS is reserved word
! Feb. 99: IDYNCU etc. removed; DYNDEP initialized
! 30.80, Nov. 98: Provision for limitation on Ctheta (refraction)
! 34.01, Feb. 99: Introducing STPNOW
! 33.08, July 98: minor changes related to the S&L scheme
! 32.06, June 99: Initialisation of IGEN
! 30.82, July 99: Initialisation of ITERMX changed from 6 to 15
! 30.80, Aug. 99: Ursell number init. as 0.
! 30.82, Aug. 99: Assigned values to PNUMS(15) and PNUMS(16). They indicate the
! allowed global errors in the iteration procedure
! 30.82, Aug. 99: Initialisation of CSETUP
! 33.10, Jan. 00: minor changes related to the SORDUP scheme
! 40.02, Sep. 00: IREFR default set to 1 (no limiter activated)
! 40.14, Jan. 01: JASTD1 removed (is not used in COMPDA array)
! 40.13, Jan. 01: COSPG is initialized at 1. (corresponding to ALPG)
! NUMOBS initialized
! subarray sequence numbers in array COMPDA changed
! 40.16, Dec. 01: Implemented limiter switches
! 40.17, Dec. 01: Implemented Multiple DIA
! 40.21, Aug. 01: diffraction approximation added
! 40.23, Aug. 02: under-relaxation factor added
! 40.23, Sep. 02: coefficient PTRIAD(5) added
! 40.23, Nov. 02: parameter PROPFL added
! 40.23, Dec. 02: reset of some default variables
! 40.30, Mar. 03: introduction distributed-memory approach using MPI
! 40.08, Mar. 03: Unneccessary variable deleted
! 40.31, Nov. 03: removing POOL construction and HPGL functionality
! 40.35, Jun. 04: output variables DISTUR and TURB added
! 40.41, Sep. 04: output variables TMM10 and RTMM10 added
! 40.41, Oct. 04: common blocks replaced by modules, include files removed
! 40.51, Feb. 05: output variable TMBOT added
! 40.51, Sep. 05: output variables WATLEV and BOTLEV added
! 40.51, Feb. 06: output variable TPS added
! 40.61, Sep. 06: output variables DISBOT, DISSRF and DISWCP added
! 40.61, Sep. 06: output variable DISMUD added
! 40.61, Sep. 06: output variable DISVEG added
! 40.64, Apr. 07: output variables Qp and BFI added
! 40.80, Jun. 07: extension to unstructured grids
! 41.12, Apr. 10: output quantity NPL added
! 41.13, Jul. 10: LWDATE introduced in view of nesting in WAM
! 41.62, Nov. 15: included output quantities for wave partitioning
!
! 2. Purpose
!
! Initialize several variables and arrays
!
! 3. Method
!
! ---
!
! 4. Argument variables
!
! INERR : Number of the initialisation error
!
INTEGER INERR
!
! 6. Local variables
!
! 7. Common blocks used
!
!
! 8. Subroutines used
!
LOGICAL STPNOW 34.01
!
! 9. Subroutines calling
!
! SWREAD
!
! 10. Error messages
!
! ---
!
! 11. Remarks
!
! ---
!
! 12. Structure
!
! ----------------------------------------------------------------
! Call OCPINI to initialize installation dependent constants
! Call VERSION to get valid version number
! Give unit references initial value
! Write heading above echo of input
! Give common variables initial value
! ----------------------------------------------------------------
!
! 13. Source text
!
VERTXT = BLANK 40.03
VERNUM = 41.10
WRITE (VERTXT, '(F5.2)') VERNUM 40.03
! CALL BUGFIX ('A')
! CALL BUGFIX ('B')
!
CALL OCPINI ('swaninit', .TRUE.,INERR) 34.01
IF (INERR.GT.0) RETURN 34.01
IF (STPNOW()) RETURN 34.01
!
WRITE (PRINTF, 6010) VERTXT 40.03
6010 FORMAT (/,20X,'---------------------------------------',
& /,20X,' SWAN',
& /,20X,'SIMULATION OF WAVES IN NEAR SHORE AREAS',
& /,20X,' VERSION NUMBER ', A, 40.03
& /,20X,'---------------------------------------',//)
!
IF (SCREEN.NE.PRINTF.AND.IAMMASTER) WRITE (SCREEN,6020) 40.95 40.30
6020 FORMAT (/, ' SWAN is preparing computation',/)
!
! ***** initial values for common variables *****
! ***** names *****
PROJID = 'SWAN'
PROJNR = BLANK
PROJT1 = BLANK
PROJT2 = BLANK
PROJT3 = BLANK
FNEST = BLANK
FBCR = BLANK
FBCL = BLANK
UH = 'm'
UV = 'm/s'
UT = 'sec'
UL = 'm'
UET = 'm3/s'
UDI = 'degr'
UST = 'm2/s2'
UF = 'N/m2'
UP = 'W/m'
UAP = 'W/m2'
UDL = 'm2/s'
! ***** physical parameters *****
GRAV = 9.81
WLEV = 0.
CASTD = 0. ! const. air-sea temp diff 40.03
CDCAP = 99999.
PI = 4.*ATAN(1.) 40.31
PI2 = 2.*PI
UNDFLW = 1.E-15
DNORTH = 90. 30.72
DEGRAD = PI/180.