WAVEWATCH III  beta 0.0.1
Functions/Subroutines
wmunitmd Module Reference

Dynamic assignement of unit numbers for the multi-grid wave model. More...

Functions/Subroutines

subroutine wmuini (NDSE, NDST)
 Allocate and initialize arrays of module. More...
 
subroutine wmudmp (NDS, IREQ)
 Display assigned unit number information from private data base. More...
 
subroutine wmuset (NDSE, NDST, NDS, FLAG, TYPE, NAME, DESC)
 Directly set information for a unit number in the data structure. More...
 
subroutine wmuget (NDSE, NDST, NDS, TYPE, NR)
 Find a free unit number for a given file type. More...
 
subroutine wmuinq (NDSE, NDST, NDS)
 Update data base information for a given unit number. More...
 

Detailed Description

Dynamic assignement of unit numbers for the multi-grid wave model.

Allowed range of unit numbers is set in parameter statements.

Author
H. L. Tolman
Date
29-May-2009

Function/Subroutine Documentation

◆ wmudmp()

subroutine wmunitmd::wmudmp ( integer, intent(in)  NDS,
integer, intent(in)  IREQ 
)

Display assigned unit number information from private data base.

Parameters
[in]NDSUnit number for output.
[in]IREQRequest identifier.
Author
H. L. Tolman
Date
25-Mar-2005

Definition at line 339 of file wmunitmd.F90.

339  !/
340  !/ +-----------------------------------+
341  !/ | WAVEWATCH III NOAA/NCEP |
342  !/ | H. L. Tolman |
343  !/ | FORTRAN 90 |
344  !/ | Last update : 25-Mar-2005 !
345  !/ +-----------------------------------+
346  !/
347  !/ 25-Mar-2005 : Origination. ( version 3.07 )
348  !/
349  ! 1. Purpose :
350  !
351  ! Display assigned unit number information from private data base.
352  !
353  ! 2. Method :
354  !
355  ! 3. Parameters :
356  !
357  ! Parameter list
358  ! ----------------------------------------------------------------
359  ! NDS Int. I Unit number for output.
360  ! IREQ Int. I Request identifier.
361  ! < 0 : Dump all data.
362  ! 0 : Dump assigned units only.
363  ! > 0 : Dump this unit only.
364  ! ----------------------------------------------------------------
365  !
366  ! 4. Subroutines used :
367  !
368  ! Name Type Module Description
369  ! ----------------------------------------------------------------
370  ! STRACE Subr. W3SERVMD Subroutine tracing.
371  ! EXTCDE Subr. Id. Program abort.
372  ! ----------------------------------------------------------------
373  !
374  ! 5. Called by :
375  !
376  ! 6. Error messages :
377  !
378  ! 7. Remarks :
379  !
380  ! 8. Structure :
381  !
382  ! 9. Switches :
383  !
384  ! !/S Enable subroutine tracing.
385  ! !/T Enable test output
386  !
387  ! 10. Source code :
388  !
389  !/ ------------------------------------------------------------------- /
390  USE w3servmd, ONLY: extcde
391 #ifdef W3_S
392  USE w3servmd, ONLY: strace
393 #endif
394  !
395  IMPLICIT NONE
396  !/
397  !/ ------------------------------------------------------------------- /
398  !/ Parameter list
399  !/
400  INTEGER, INTENT(IN) :: NDS, IREQ
401  !/
402  !/ ------------------------------------------------------------------- /
403  !/ Local parameters
404  !/
405  INTEGER :: I
406 #ifdef W3_S
407  INTEGER, SAVE :: IENT = 0
408 #endif
409  !/
410 #ifdef W3_S
411  CALL strace (ient, 'WMUDMP')
412 #endif
413  !
414  ! -------------------------------------------------------------------- /
415  ! 1. Test request and intialization
416  !
417  IF ( .NOT. flinit ) THEN
418  WRITE (nds,1000)
419  CALL extcde ( 1000 )
420  END IF
421  !
422  IF ( ireq.GT.0 .AND. ( ireq.LT.unitlw .OR. ireq.GT.unithg) ) THEN
423  WRITE (nds,1001) ireq, unitlw, unithg
424  CALL extcde ( 1001 )
425  END IF
426  !
427  ! -------------------------------------------------------------------- /
428  ! 2. Single unit request
429  !
430  IF ( ireq .GT. 0 ) THEN
431  WRITE (nds,920) ireq, u_used(ireq), u_type(ireq), &
432  u_name(ireq), u_desc(ireq)
433  !
434  ! -------------------------------------------------------------------- /
435  ! 3. Multiple unit request
436  !
437  ELSE
438  !
439  IF ( ireq .LT. 0 ) THEN
440  WRITE (nds,930)
441  ELSE
442  WRITE (nds,931)
443  END IF
444  !
445  DO i=unitlw, unithg
446  IF ( ireq.LT.0 .OR. u_used(i) ) &
447  WRITE (nds,932) i, u_used(i), u_type(i), &
448  u_name(i), u_desc(i)
449  END DO
450  WRITE (nds,*)
451  !
452  END IF
453  !
454  RETURN
455  !
456  ! Formats
457  !
458 920 FORMAT (/' WMUDMP: Unit number : ',i6/ &
459  ' Assigned : ',l6/ &
460  ' Type : ',a/ &
461  ' Name : ',a/ &
462  ' Description : ',a/)
463  !
464 930 FORMAT (/' WMUDMP: Unit information '// &
465  ' Nr Flg Type Name Description '/ &
466  ' -------------------------------------------------', &
467  '---------------------')
468 931 FORMAT (/' WMUDMP: Unit information (assigned only)'// &
469  ' Nr Flg Type Name Description '/ &
470  ' -------------------------------------------------', &
471  '---------------------')
472 932 FORMAT ( 2x,i4,l4,2x,a3,2x,a20,2x,a)
473  !
474 1000 FORMAT (/' *** ERROR WMUDMP: DATA STRUCTURE READY ***'/ &
475  /' RUN WMUINI FIRST '/)
476 1001 FORMAT (/' *** ERROR WMUDMP: UNIT NUMBER OUT OF RANGE ***' &
477  /' REQ/RANG :',3i6/)
478  !/
479  !/ End of WMUDMP ----------------------------------------------------- /
480  !/

References w3servmd::extcde(), and w3servmd::strace().

Referenced by wminitmd::wminit(), and wminitmd::wminitnml().

◆ wmuget()

subroutine wmunitmd::wmuget ( integer, intent(in)  NDSE,
integer, intent(in)  NDST,
integer, intent(out)  NDS,
character(len=3), intent(in)  TYPE,
integer, intent(in), optional  NR 
)

Find a free unit number for a given file type.

Search the data base.

Parameters
[in]NDSEUnit number for error output.
[in]NDSTUnit number for test output.
[out]NDSUnit number to be assigned.
[in]TYPEType identifier to be used.
[in]NRNumber of consecutive units needed for output bounday data files.
Author
H. L. Tolman
Date
20-Jan-2017

Definition at line 667 of file wmunitmd.F90.

667  !/
668  !/ +-----------------------------------+
669  !/ | WAVEWATCH III NOAA/NCEP |
670  !/ | H. L. Tolman |
671  !/ | FORTRAN 90 |
672  !/ | Last update : 20-Jan-2017 !
673  !/ +-----------------------------------+
674  !/
675  !/ 28-Mar-2005 : Origination. ( version 3.07 )
676  !/ 20-Jan-2017 : Add INQUIRE OPENED check. ( version 6.02 )
677  !/ (T. J. Campbell, NRL)
678  !/
679  ! 1. Purpose :
680  !
681  ! Find a free unit number for a given file type.
682  !
683  ! 2. Method :
684  !
685  ! Search the data base.
686  !
687  ! 3. Parameters :
688  !
689  ! Parameter list
690  ! ----------------------------------------------------------------
691  ! NDSE Int. I Unit number for error output.
692  ! NDST Int. I Unit number for test output.
693  ! NDS Int. O Unit number to be assigned.
694  ! TYPE C*3 I Type identifier to be used.
695  ! NR Int. I Number of consecutive units needed.
696  ! Needed for output bounday data files.
697  ! ----------------------------------------------------------------
698  !
699  ! 4. Subroutines used :
700  !
701  ! Name Type Module Description
702  ! ----------------------------------------------------------------
703  ! STRACE Sur. W3SERVMD Subroutine tracing.
704  ! EXCTDE Sur. Id. Program abort.
705  ! ----------------------------------------------------------------
706  !
707  ! 5. Called by :
708  !
709  ! 6. Error messages :
710  !
711  ! 7. Remarks :
712  !
713  ! 8. Structure :
714  !
715  ! 9. Switches :
716  !
717  ! !/S Enable subroutine tracing.
718  ! !/T Enable test output
719  !
720  ! 10. Source code :
721  !
722  !/ ------------------------------------------------------------------- /
723  USE w3servmd, ONLY: extcde
724 #ifdef W3_S
725  USE w3servmd, ONLY: strace
726 #endif
727  !
728  IMPLICIT NONE
729  !/
730  !/ ------------------------------------------------------------------- /
731  !/ Parameter list
732  !/
733  INTEGER, INTENT(IN) :: NDSE, NDST
734  INTEGER, INTENT(OUT) :: NDS
735  CHARACTER(LEN=3), INTENT(IN) :: TYPE
736  INTEGER, INTENT(IN), OPTIONAL :: NR
737  !/
738  !/ ------------------------------------------------------------------- /
739  !/ Local parameters
740  !/
741  INTEGER :: NRC, I, J
742 #ifdef W3_S
743  INTEGER, SAVE :: IENT = 0
744 #endif
745  LOGICAL :: OK
746  LOGICAL :: OPND
747  !/
748 #ifdef W3_S
749  CALL strace (ient, 'WMUGET')
750 #endif
751  !
752  ! -------------------------------------------------------------------- /
753  ! 1. Test input / output
754  !
755  IF ( .NOT. flinit ) THEN
756  WRITE (ndse,1010)
757  CALL extcde ( 1010 )
758  END IF
759  !
760  IF ( PRESENT(nr) ) THEN
761  nrc = max( 1 , nr )
762  ELSE
763  nrc = 1
764  END IF
765  !
766 #ifdef W3_T
767  WRITE (ndst,9010) TYPE, NRC
768 #endif
769  !
770  ! -------------------------------------------------------------------- /
771  ! 2. Find first free unit number and reset flag
772  !
773  nds = -1
774  !
775  DO i=unitlw, unithg - nrc + 1
776  ! new: We do not allow I=NDST (unit number for test output).
777  ! NDST (aka MDST or IDST) is set to 10 in call to WMINIT
778  ! (4th argument)
779  ok = .NOT.u_used(i) .AND. u_type(i).EQ.TYPE &
780  .AND. i.NE.ndst
781  INQUIRE ( i, opened=opnd )
782  ok = ok .AND. .NOT.opnd
783  IF ( ok ) THEN
784  DO j=1, nrc-1
785  ok = ok .AND. (.NOT.u_used(i+j) .AND. &
786  u_type(i+j).EQ.TYPE )
787  INQUIRE ( i+j, opened=opnd )
788  ok = ok .AND. .NOT.opnd
789  END DO
790  END IF
791  IF ( ok ) THEN
792  nds = i
793  DO j=0, nrc-1
794  u_used(i+j) = .true.
795  END DO
796  EXIT
797  END IF
798  END DO
799  !
800  IF ( nds .EQ. -1 ) THEN
801  WRITE (ndse,1020) TYPE
802  CALL extcde ( 1020 )
803  END IF
804  !
805 #ifdef W3_T
806  WRITE (ndst,9020) nds
807 #endif
808  !
809  RETURN
810  !
811  ! Formats
812  !
813 1010 FORMAT (/' *** ERROR WMUGET: INITIALIZE FIRST !!! ***')
814 1020 FORMAT (/' *** ERROR WMUGET: CANNOT FIND FREE UNIT FOR TYPE ', &
815  a,' ***'/)
816  !
817 #ifdef W3_T
818 9010 FORMAT ( ' TEST WMUGET: LOOKING FOR UNIT FOR TYPE ',a,' [', &
819  i2,']')
820 9020 FORMAT ( ' TEST WMUGET: UNIT NUMBER SET TO',i4)
821 #endif
822  !/
823  !/ End of WMUGET ----------------------------------------------------- /
824  !/

References w3servmd::extcde(), and w3servmd::strace().

Referenced by wmesmfmd::readfromfile(), w3sbs1(), wminitmd::wminit(), and wminitmd::wminitnml().

◆ wmuini()

subroutine wmunitmd::wmuini ( integer, intent(in)  NDSE,
integer, intent(in)  NDST 
)

Allocate and initialize arrays of module.

Allocate and test parameter setting.

Parameters
[in]NDSEUnit number for error output.
[in]NDSTUnit number for test output.
Author
H. L. Tolman
Date
25-Mar-2005

Definition at line 126 of file wmunitmd.F90.

126  !/
127  !/ +-----------------------------------+
128  !/ | WAVEWATCH III NOAA/NCEP |
129  !/ | H. L. Tolman |
130  !/ | FORTRAN 90 |
131  !/ | Last update : 25-Mar-2005 !
132  !/ +-----------------------------------+
133  !/
134  !/ 25-Mar-2005 : Origination. ( version 3.07 )
135  !/
136  ! 1. Purpose :
137  !
138  ! Allocate and initialize arrays of module.
139  !
140  ! 2. Method :
141  !
142  ! Allocate and test parameter setting.
143  !
144  ! 3. Parameters :
145  !
146  ! Parameter list
147  ! ----------------------------------------------------------------
148  ! NDSE Int. I Unit number for error output.
149  ! NDST Int. I Unit number for test output.
150  ! ----------------------------------------------------------------
151  !
152  ! 4. Subroutines used :
153  !
154  ! Name Type Module Description
155  ! ----------------------------------------------------------------
156  ! STRACE Subr. W3SERVMD Subroutine tracing.
157  ! EXTCDE Subr. Id. Program abort.
158  ! ----------------------------------------------------------------
159  !
160  ! 5. Called by :
161  !
162  ! 6. Error messages :
163  !
164  ! See source code.
165  !
166  ! 7. Remarks :
167  !
168  ! 8. Structure :
169  !
170  ! See source code.
171  !
172  ! 9. Switches :
173  !
174  ! !/S Enable subroutine tracing.
175  ! !/T Enable test output
176  !
177  ! 10. Source code :
178  !
179  !/ ------------------------------------------------------------------- /
180  USE w3servmd, ONLY: extcde
181 #ifdef W3_S
182  USE w3servmd, ONLY: strace
183 #endif
184  !
185  IMPLICIT NONE
186  !/
187  !/ ------------------------------------------------------------------- /
188  !/ Parameter list
189  !/
190  INTEGER, INTENT(IN) :: NDSE, NDST
191  !/
192  !/ ------------------------------------------------------------------- /
193  !/ Local parameters
194  !/
195  INTEGER :: J, I1, IN, I
196 #ifdef W3_S
197  INTEGER, SAVE :: IENT = 0
198 #endif
199  CHARACTER(LEN=3) :: STRING
200  !/
201 #ifdef W3_S
202  CALL strace (ient, 'WMUINI')
203 #endif
204  !
205  ! -------------------------------------------------------------------- /
206  ! 1. Test parameter settings
207  !
208 #ifdef W3_T
209  WRITE (ndst,9000)
210 #endif
211  !
212  IF ( unitlw .GE. unithg ) THEN
213  WRITE (ndse,1000) unitlw, unithg
214  CALL extcde ( 1000 )
215  END IF
216  !
217  IF ( unitlw .GT. inplow .OR. &
218  unitlw .GT. outlow .OR. &
219  unitlw .GT. scrlow ) THEN
220  WRITE (ndse,1001) unitlw, inplow, outlow, scrlow
221  CALL extcde ( 1001 )
222  END IF
223  !
224  IF ( unithg .LT. inphgh .OR. &
225  unithg .LT. outhgh .OR. &
226  unithg .LT. scrhgh ) THEN
227  WRITE (ndse,1002) unithg, inphgh, outhgh, scrhgh
228  CALL extcde ( 1002 )
229  END IF
230  !
231  IF ( flinit ) THEN
232  WRITE (ndse,1003)
233  CALL extcde ( 1003 )
234  END IF
235  !
236  ! -------------------------------------------------------------------- /
237  ! 1. Allocate and initialize arrays
238  !
239 #ifdef W3_T
240  WRITE (ndst,9010) unitlw, unithg
241 #endif
242  !
243  ALLOCATE ( u_used(unitlw:unithg) , u_type(unitlw:unithg) , &
244  u_name(unitlw:unithg) , u_desc(unitlw:unithg) )
245  !
246  u_used = .false.
247  u_type = 'RES'
248  u_name = 'unknown'
249  u_desc = 'unknown'
250  !
251  ! -------------------------------------------------------------------- /
252  ! 2. Designate file types
253  !
254 #ifdef W3_T
255  WRITE (ndst,9020)
256 #endif
257  !
258  DO j=1, 3
259  !
260  SELECT CASE(j)
261  CASE(1)
262  string = 'INP'
263  i1 = inplow
264  in = inphgh
265  CASE(2)
266  string = 'OUT'
267  i1 = outlow
268  in = outhgh
269  CASE DEFAULT
270  string = 'SCR'
271  i1 = scrlow
272  in = scrhgh
273  END SELECT
274  !
275  DO i=i1, in
276  IF ( u_type(i) .NE. 'RES' ) THEN
277  WRITE (ndse,1020) i, u_type(i)
278  END IF
279  u_type(i) = string
280  END DO
281  END DO
282  !
283  ! -------------------------------------------------------------------- /
284  ! 3. Set flags
285  !
286 #ifdef W3_T
287  WRITE (ndst,9030)
288 #endif
289  !
290  flinit = .true.
291  !
292  ! -------------------------------------------------------------------- /
293  ! 4. Test output
294  !
295 #ifdef W3_T
296  WRITE (ndst,9040)
297  DO i=unitlw, unithg
298  WRITE (ndst,9041) i,u_used(i),u_type(i),u_name(i),u_desc(i)
299  END DO
300 #endif
301  !
302  RETURN
303  !
304  ! Formats
305  !
306 1000 FORMAT (/' *** ERROR WMUINI: ILLEGAL UNIT RANGE ***'/ &
307  ' LOW - HIGH : ',2i10/)
308 1001 FORMAT (/' *** ERROR WMUINI: ILLEGAL LOWER LIMITS ***'/ &
309  ' ',4i10/)
310 1002 FORMAT (/' *** ERROR WMUINI: ILLEGAL HIGHER LIMITS ***'/ &
311  ' ',4i10/)
312 1003 FORMAT (/' *** ERROR WMUINI: DATA ALREADY INITIALIZED ***'/)
313 1020 FORMAT (/' *** WARNING WMUINI: UNIT',i4,' ALREADY ASSIGNED [', &
314  a,'] ***')
315  !
316 #ifdef W3_T
317 9000 FORMAT ( ' TEST WMUNINI: STARTING ROUTINE')
318 9010 FORMAT ( ' TEST WMUNINI: ALLOCATING ARRAYS ',2i6)
319 9020 FORMAT ( ' TEST WMUNINI: INITALIZING ARRAYS')
320 9030 FORMAT ( ' TEST WMUNINI: SETTING FLAGS')
321 9040 FORMAT ( ' TEST WMUNINI: DATA STRUCTURE AFTER INITIALIZATION')
322 9041 FORMAT ( 5x,i4,l4,3(2x,a))
323 #endif
324  !/
325  !/ End of WMUINI ----------------------------------------------------- /
326  !/

References w3servmd::extcde(), and w3servmd::strace().

Referenced by wminitmd::wminit(), and wminitmd::wminitnml().

◆ wmuinq()

subroutine wmunitmd::wmuinq ( integer, intent(in)  NDSE,
integer, intent(in)  NDST,
integer, intent(in)  NDS 
)

Update data base information for a given unit number.

FORTRAN INQUIRE statement.

Parameters
[in]NDSEUnit number for error output.
[in]NDSTUnit number for test output.
[in]NDSUnit number to be assigned.
Author
H. L. Tolman
Date
29-Mar-2005

Definition at line 839 of file wmunitmd.F90.

839  !/
840  !/ +-----------------------------------+
841  !/ | WAVEWATCH III NOAA/NCEP |
842  !/ | H. L. Tolman |
843  !/ | FORTRAN 90 |
844  !/ | Last update : 29-Mar-2005 !
845  !/ +-----------------------------------+
846  !/
847  !/ 29-Mar-2005 : Origination. ( version 3.07 )
848  !/
849  ! 1. Purpose :
850  !
851  ! Update data base information for a given unit number.
852  !
853  ! 2. Method :
854  !
855  ! FORTRAN INQUIRE statement.
856  !
857  ! 3. Parameters :
858  !
859  ! Parameter list
860  ! ----------------------------------------------------------------
861  ! NDSE Int. I Unit number for error output.
862  ! NDST Int. I Unit number for test output.
863  ! NDS Int. I Unit number to be assigned.
864  ! ----------------------------------------------------------------
865  !
866  ! 4. Subroutines used :
867  !
868  ! Name Type Module Description
869  ! ----------------------------------------------------------------
870  ! STRACE Sur. W3SERVMD Subroutine tracing.
871  ! EXCTDE Sur. Id. Program abort.
872  ! ----------------------------------------------------------------
873  !
874  ! 5. Called by :
875  !
876  ! 6. Error messages :
877  !
878  ! 7. Remarks :
879  !
880  ! 8. Structure :
881  !
882  ! 9. Switches :
883  !
884  ! !/S Enable subroutine tracing.
885  ! !/T Enable test output
886  !
887  ! 10. Source code :
888  !
889  !/ ------------------------------------------------------------------- /
890  USE w3servmd, ONLY: extcde
891 #ifdef W3_S
892  USE w3servmd, ONLY: strace
893 #endif
894  !
895  IMPLICIT NONE
896  !/
897  !/ ------------------------------------------------------------------- /
898  !/ Parameter list
899  !/
900  INTEGER, INTENT(IN) :: NDSE, NDST, NDS
901  !/
902  !/ ------------------------------------------------------------------- /
903  !/ Local parameters
904  !/
905 #ifdef W3_S
906  INTEGER, SAVE :: IENT = 0
907 #endif
908  LOGICAL :: CHECK
909  !/
910 #ifdef W3_S
911  CALL strace (ient, 'WMUINQ')
912 #endif
913  !
914  ! -------------------------------------------------------------------- /
915  ! 1. Test input / output
916  !
917  IF ( .NOT. flinit ) THEN
918  WRITE (ndse,1010)
919  CALL extcde ( 1010 )
920  END IF
921  !
922  IF ( nds.LT.unitlw .OR. nds.GT.unithg ) THEN
923  WRITE (ndse,1011) nds, unitlw, unithg
924  CALL extcde ( 1011 )
925  END IF
926  !
927 #ifdef W3_T
928  WRITE (ndst,9010) nds
929 #endif
930  !
931  ! -------------------------------------------------------------------- /
932  ! 2. Check out file
933  ! 2.a Check if opened :
934  !
935  INQUIRE (nds,opened=check)
936  !
937 #ifdef W3_T
938  WRITE (ndst,9020) check
939 #endif
940  !
941  ! 2.b File not opened, release to pool
942  !
943  IF ( .NOT. check ) THEN
944  CALL wmuset ( ndse, ndst, nds, .false. )
945  ELSE
946  !
947  ! 2.c File is opened, get the name
948  !
949  INQUIRE (nds,name=u_name(nds))
950  !
951 #ifdef W3_T
952  WRITE (ndst,9021) u_name(nds)
953 #endif
954  !
955  END IF
956  !
957  RETURN
958  !
959  ! Escape locations read errors --------------------------------------- *
960  !
961  !
962  ! Formats
963  !
964 1010 FORMAT (/' *** ERROR WMUINQ: INITIALIZE FIRST !!! ***')
965 1011 FORMAT (/' *** ERROR WMUINQ: UNIT NUMBER OUT OF RANGE ***' &
966  /' REQ/RANG :',3i6/)
967  !
968 #ifdef W3_T
969 9010 FORMAT ( ' TEST WMUINQ: TESTING UNIT NUMBER',i4)
970 9020 FORMAT ( ' INQUIRE ON OPENED : ',l2)
971 9021 FORMAT ( ' NAME OF FILE : ',a)
972 #endif
973  !/
974  !/ End of WMUINQ ----------------------------------------------------- /
975  !/

References check(), w3servmd::extcde(), w3servmd::strace(), and wmuset().

Referenced by wminitmd::wminit(), and wminitmd::wminitnml().

◆ wmuset()

subroutine wmunitmd::wmuset ( integer, intent(in)  NDSE,
integer, intent(in)  NDST,
integer, intent(in)  NDS,
logical, intent(in)  FLAG,
character(len=3), intent(in), optional  TYPE,
character*(*), intent(in), optional  NAME,
character*(*), intent(in), optional  DESC 
)

Directly set information for a unit number in the data structure.

Parameters
[in]NDSEUnit number for error output.
[in]NDSTUnit number for test output.
[in]NDSUnit number to be assigned.
[in]FLAGFlag for assigning unit.
[in]TYPEType identifier to be used.
[in]NAMEName of file.
[in]DESCDescription of file.
Author
H. L. Tolman
Date
25-Mar-2005

Definition at line 497 of file wmunitmd.F90.

497  !/
498  !/ +-----------------------------------+
499  !/ | WAVEWATCH III NOAA/NCEP |
500  !/ | H. L. Tolman |
501  !/ | FORTRAN 90 |
502  !/ | Last update : 25-Mar-2005 !
503  !/ +-----------------------------------+
504  !/
505  !/ 25-Mar-2005 : Origination. ( version 3.07 )
506  !/
507  ! 1. Purpose :
508  !
509  ! Directly set information for a unit number in the data structure.
510  !
511  ! 2. Method :
512  !
513  ! 3. Parameters :
514  !
515  ! Parameter list
516  ! ----------------------------------------------------------------
517  ! NDSE Int. I Unit number for error output.
518  ! NDST Int. I Unit number for test output.
519  ! NDS Int. I Unit number to be assigned.
520  ! FLAG Log. I Flag for assigning unit.
521  ! TYPE C*3 I Type identifier to be used.
522  ! NAME C* I Name of file.
523  ! DESC C* I Description of file.
524  ! ----------------------------------------------------------------
525  !
526  ! 4. Subroutines used :
527  !
528  ! Name Type Module Description
529  ! ----------------------------------------------------------------
530  ! STRACE Sur. W3SERVMD Subroutine tracing.
531  ! EXCTDE Sur. Id. Program abort.
532  ! ----------------------------------------------------------------
533  !
534  ! 5. Called by :
535  !
536  ! 6. Error messages :
537  !
538  ! 7. Remarks :
539  !
540  ! 8. Structure :
541  !
542  ! 9. Switches :
543  !
544  ! !/S Enable subroutine tracing.
545  ! !/T Enable test output
546  !
547  ! 10. Source code :
548  !
549  !/ ------------------------------------------------------------------- /
550  USE w3servmd, ONLY: extcde
551 #ifdef W3_S
552  USE w3servmd, ONLY: strace
553 #endif
554  !
555  IMPLICIT NONE
556  !/
557  !/ ------------------------------------------------------------------- /
558  !/ Parameter list
559  !/
560  INTEGER, INTENT(IN) :: NDSE, NDST, NDS
561  LOGICAL, INTENT(IN) :: FLAG
562  CHARACTER(LEN=3), INTENT(IN), OPTIONAL :: &
563  TYPE
564  CHARACTER*(*), INTENT(IN), OPTIONAL :: &
565  NAME, DESC
566  !/
567  !/ ------------------------------------------------------------------- /
568  !/ Local parameters
569  !/
570 #ifdef W3_S
571  INTEGER, SAVE :: IENT = 0
572 #endif
573  !/
574 #ifdef W3_S
575  CALL strace (ient, 'WMUSET')
576 #endif
577  !
578  ! -------------------------------------------------------------------- /
579  ! 1. Test input
580  !
581  IF ( .NOT. flinit ) THEN
582  WRITE (ndse,1000)
583  CALL extcde ( 1000 )
584  END IF
585  !
586  IF ( nds.LT.unitlw .OR. nds.GT.unithg ) THEN
587  WRITE (ndse,1001) nds, unitlw, unithg
588  CALL extcde ( 1001 )
589  END IF
590  !
591 #ifdef W3_T
592  WRITE (ndst,9000) nds, u_used(nds), u_type(nds), &
593  u_name(nds), u_desc(nds)
594 #endif
595  !
596  ! -------------------------------------------------------------------- /
597  ! 2. Set data
598  ! 2.a Flag
599  !
600  u_used(nds) = flag
601  !
602  ! 2.b Type
603  !
604  IF ( PRESENT(type) ) u_type(nds) = TYPE
605  !
606  ! 2.c Name
607  !
608  IF ( PRESENT(name) ) THEN
609  u_name(nds) = name
610  ELSE IF ( .NOT. flag ) THEN
611  u_name(nds) = 'unknown'
612  END IF
613  !
614  ! 2.d Description
615  !
616  IF ( PRESENT(desc) ) THEN
617  u_desc(nds) = desc
618  ELSE IF ( .NOT. flag ) THEN
619  u_desc(nds) = 'unknown'
620  END IF
621  !
622 #ifdef W3_T
623  WRITE (ndst,9001) nds, u_used(nds), u_type(nds), &
624  u_name(nds), u_desc(nds)
625 #endif
626  !
627  RETURN
628  !
629  ! Formats
630  !
631 1000 FORMAT (/' *** ERROR WMUSET: INITIALIZE FIRST !!! ***')
632 1001 FORMAT (/' *** ERROR WMUSET: UNIT NUMBER OUT OF RANGE ***' &
633  /' REQ/RANG :',3i6/)
634  !
635 #ifdef W3_T
636 9000 FORMAT ( ' TEST WMUSET: UNIT ',i4', ON SUBROUTINE ENTRY :'/ &
637  ' FLAG : ',l4/ &
638  ' TYPE : ',a/ &
639  ' NAME : ',a/ &
640  ' DESC : ' a)
641 9001 FORMAT ( ' TEST WMUSET: UNIT ',i4', ON SUBROUTINE EXIT :'/ &
642  ' FLAG : ',l4/ &
643  ' TYPE : ',a/ &
644  ' NAME : ',a/ &
645  ' DESC : ' a)
646 #endif
647  !/
648  !/ End of WMUSET ----------------------------------------------------- /
649  !/

References w3servmd::extcde(), and w3servmd::strace().

Referenced by wmesmfmd::readfromfile(), w3sbs1(), wminitmd::wminit(), wminitmd::wminitnml(), and wmuinq().

w3tidemd::nr
integer, parameter nr
Definition: w3tidemd.F90:92
wmunitmd::wmuset
subroutine wmuset(NDSE, NDST, NDS, FLAG, TYPE, NAME, DESC)
Directly set information for a unit number in the data structure.
Definition: wmunitmd.F90:497
w3servmd
Definition: w3servmd.F90:3
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148