Page 1 Source Listing READMSH 2014-09-16 16:48 w3triamd.f90 1 MODULE W3TRIAMD 2 !/ ------------------------------------------------------------------- 3 !/ +-----------------------------------+ 4 !/ | WAVEWATCH III NOAA/NCEP | 5 !/ | F. Ardhuin and A. Roland | 6 !/ | FORTRAN 90 | 7 !/ | Last update : 14-Oct-2013| 8 !/ +-----------------------------------+ 9 !/ 10 !/ 15-Mar-2007 : Origination. ( version 3.13 ) 11 !/ 25-Aug-2011 : Modification of boundary treatment ( version 4.04 ) 12 !/ 30-Aug-2012 : Automatic detection of open BC ( version 4.08 ) 13 !/ 02-Sep-2012 : Clean up of open BC for UG grids ( version 4.08 ) 14 !/ 14-Oct-2013 : Correction of latitude factor ( version 4.12 ) 15 !/ 16 ! 17 ! 1. Purpose : 18 ! 19 ! Reads triangle and unstructured grid information 20 ! 21 ! 2. Method : 22 ! 23 ! Look for namelist with name NAME in unit NDS and read if found. 24 ! 25 ! 3. Parameters : 26 ! 27 ! 4. Subroutines used : 28 ! 29 ! Name Type Module Description 30 ! ------------------------------------------------------------------------------------ 31 ! READTRI Subr. Internal Read unstructured grid data from .grd .tri formatted files. 32 ! READMSH Subr. Id. Read unstructured grid data from MSH format 33 ! COUNT Subr. Internal Count connection. 34 ! SPATIAL_GRID Subr. Id. Calculate surfaces. 35 ! NVECTRI Subr. Id. Define cell normals and angles and edge length 36 ! COORDMAX Subr. Id. Calculate useful grid elements 37 ! AREA_SI Subr. Id. Define Connections 38 ! ------------------------------------------------------------------------------------ 39 ! 40 ! 5. Called by : 41 ! 42 ! Program in which it is contained. 43 ! 44 ! 6. Error messages : 45 ! 46 ! 7. Remarks : 47 ! The only point index which is needed is IX and NX stands for the total number of grid point. 48 ! IY and NY are not needed anymore, they are set to 1 in the unstructured case 49 ! Some noticeable arrays are: 50 ! XYB : give the 2D coordinates of all grid points 51 ! TRIGP : give the vertices of each triangle 52 ! 8. Structure : 53 ! 54 ! 9. Switches : 55 ! !/PR3 : Enables unstructured meshes (temporary, will be replace by Unstructured switch) 56 ! 10. Source code : 57 ! Page 2 Source Listing READMSH 2014-09-16 16:48 w3triamd.f90 58 !/ ------------------------------------------------------------------- / 59 PUBLIC 60 ! USE CONSTANTS 61 ! USE W3GDATMD, ONLY: W3NMOD, W3SETG 62 ! USE W3ODATMD, ONLY: W3NO I2, I2 -> I3, I3 -> I1 (anticlockwise orientation is preserved) 666 ! 667 R1 = P3-P2 668 R2 = P1-P3 669 R3 = P2-P1 670 671 N1(1) = (-R1(2)) 672 N1(2) = ( R1(1)) 673 N2(1) = (-R2(2)) 674 N2(2) = ( R2(1)) 675 N3(1) = (-R3(2)) 676 N3(2) = ( R3(1)) 677 ! 678 ! edges length 679 ! 680 LEN(IE,1) = SQRT(R1(1)**2+R1(2)**2) 681 LEN(IE,2) = SQRT(R2(1)**2+R2(2)**2) 682 LEN(IE,3) = SQRT(R3(1)**2+R3(2)**2) 683 ! 684 ! inward normal used for propagation (not normalized) 685 ! 686 IEN(IE,1) = N1(1) 687 IEN(IE,2) = N1(2) 688 IEN(IE,3) = N2(1) 689 IEN(IE,4) = N2(2) 690 IEN(IE,5) = N3(1) 691 IEN(IE,6) = N3(2) 692 693 TMP(1) = DOT_PRODUCT(R3,-R2) 694 TMP(2) = DOT_PRODUCT(R1,-R3) 695 TMP(3) = DOT_PRODUCT(R2,-R1) 696 697 TMPINV(1) = 1./ (LEN(IE,2) * LEN(IE,3)) 698 TMPINV(2) = 1./ (LEN(IE,1) * LEN(IE,3)) 699 TMPINV(3) = 1./ (LEN(IE,2) * LEN(IE,1)) 700 701 TMP(1) = DOT_PRODUCT(R3,-R2) * TMPINV(1) Page 19 Source Listing NVECTRI 2014-09-16 16:48 w3triamd.f90 702 TMP(2) = DOT_PRODUCT(R1,-R3) * TMPINV(2) 703 TMP(3) = DOT_PRODUCT(R2,-R1) * TMPINV(3) 704 ! 705 ! angles used in gradients computation 706 ! 707 ANGLE0(IE,1) = ACOS(TMP(1)) 708 ANGLE0(IE,2) = ACOS(TMP(2)) 709 ANGLE0(IE,3) = ACOS(TMP(3)) 710 !WRITE(997,*) 'IE, ANGLE:',IE,ANGLE0(IE,1:3)*RADE 711 !TRIA03(IE)=TRIA(IE)*1./3. 712 END DO 713 714 END SUBROUTINE ENTRY POINTS Name w3triamd_mp_nvectri_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ACOS Func 707 scalar 707,708,709 ANGLE0 Local 707 R(4) 4 2 1 PTR 707,708,709 CONSTANTS Module 632 632 DOT_PRODUCT Func 693 scalar 693,694,695,701,702,703 I1 Local 641 I(4) 4 scalar 654,658,659 I11 Local 641 I(4) 4 scalar I2 Local 641 I(4) 4 scalar 655,660,661 I22 Local 641 I(4) 4 scalar I3 Local 641 I(4) 4 scalar 656,662,663 I33 Local 641 I(4) 4 scalar IE Local 640 I(4) 4 scalar 650,654,655,656,680,681,682,686,68 7,688,689,690,691,697,698,699,707, 708,709 IEN Local 686 R(4) 4 2 1 PTR 686,687,688,689,690,691 IP Local 640 I(4) 4 scalar LEN Local 680 R(4) 4 2 1 PTR 680,681,682,697,698,699 N1 Local 644 R(4) 4 1 2 671,672,686,687 N2 Local 644 R(4) 4 1 2 673,674,688,689 N3 Local 644 R(4) 4 1 2 675,676,690,691 NTRI Local 650 I(4) 4 scalar PTR 650 NVECTRI Subr 590 319 P1 Local 642 R(4) 4 1 2 658,659,668,669 P2 Local 642 R(4) 4 1 2 660,661,667,669 P3 Local 642 R(4) 4 1 2 662,663,667,668 R1 Local 643 R(4) 4 1 2 667,671,672,680,694,695,702,703 R2 Local 643 R(4) 4 1 2 668,673,674,681,693,695,701,703 R3 Local 643 R(4) 4 1 2 669,675,676,682,693,694,701,702 SQRT Func 680 scalar 680,681,682 TMP Local 645 R(4) 4 1 3 693,694,695,701,702,703,707,708,70 9 TMPINV Local 646 R(4) 4 1 3 697,698,699,701,702,703 Page 20 Source Listing NVECTRI 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References TRIGP Local 654 I(4) 4 2 1 PTR 654,655,656 W3GDATMD Module 631 631 XYB Local 658 R(8) 8 2 1 PTR 658,659,660,661,662,663 Page 21 Source Listing NVECTRI 2014-09-16 16:48 w3triamd.f90 715 716 717 SUBROUTINE COUNT(TRIGPTEMP) 718 719 !/ ------------------------------------------------------------------- 720 !/ +-----------------------------------+ 721 !/ | WAVEWATCH III NOAA/NCEP | 722 !/ | F. Ardhuin | 723 !/ | FORTRAN 90 | 724 !/ | Last update : 15-May-2008| 725 !/ +-----------------------------------+ 726 !/ 727 !/ 15-May-2007 : Origination. ( version 3.13 ) 728 !/ 729 ! 730 ! 1. Purpose : 731 ! 732 ! Calculate global and maximum number of connection for array allocations . 733 ! 734 ! 2. Method : 735 ! 736 ! 3. Parameters : 737 ! Parameter list 738 ! ---------------------------------------------------------------- 739 ! NTRI Int. I Total number of triangle. 740 ! TRIGPTEMP Int I Temporary array of triangle vertices 741 ! COUNTRI Int O Maximum number of connected triangle 742 ! for a given points 743 ! COUNTOT Int O Global number of triangle connection 744 ! for the whole grid. 745 ! ---------------------------------------------------------------- 746 ! 4. Subroutines used : 747 ! 748 ! 5. Called by : 749 ! 750 ! Name Type Module Description 751 ! ---------------------------------------------------------------- 752 ! READTRI Subr. Internal Unstructured mesh definition. 753 ! ---------------------------------------------------------------- 754 ! 755 ! 6. Error messages : 756 ! 757 ! 7. Remarks : 758 ! 759 ! 8. Structure : 760 ! 761 ! 9. Switches : 762 ! 763 ! 10. Source code : 764 ! 765 !/ ------------------------------------------------------------------- / 766 USE W3GDATMD 767 IMPLICIT NONE 768 769 770 !/ parameter list 771 Page 22 Source Listing COUNT 2014-09-16 16:48 w3triamd.f90 772 INTEGER,INTENT(IN) :: TRIGPTEMP(:,:) 773 !/ ------------------------------------------------------------------- / 774 !/ local parameter 775 776 INTEGER :: CONN(NX) 777 INTEGER :: COUNTER, IP, IE, I, J, N(3) 778 779 780 COUNTRI=0 781 COUNTOT=0 782 CONN(:)= 0 783 784 ! 785 !calculate the number of connected triangles for a given point. 786 ! 787 788 DO IE = 1,NTRI 789 N(:) = 0. 790 N(1) = TRIGPTEMP(IE,1) 791 N(2) = TRIGPTEMP(IE,2) 792 N(3) = TRIGPTEMP(IE,3) 793 CONN(N(1)) = CONN(N(1)) + 1 794 CONN(N(2)) = CONN(N(2)) + 1 795 CONN(N(3)) = CONN(N(3)) + 1 796 ENDDO 797 798 COUNTRI = MAXVAL(CONN) 799 ! 800 ! calculate the global number of connections available through the mesh 801 ! 802 J=0 803 DO IP=1,NX 804 DO I=1,CONN(IP) 805 J=J+1 806 ENDDO 807 ENDDO 808 COUNTOT=J 809 810 END SUBROUTINE Page 23 Source Listing COUNT 2014-09-16 16:48 Entry Points w3triamd.f90 ENTRY POINTS Name w3triamd_mp_count_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References CONN Local 776 I(4) 4 1 0 782,793,794,795,798,804 COUNT Subr 717 299 COUNTER Local 777 I(4) 4 scalar COUNTOT Local 781 I(4) 4 scalar PTR 781,808 COUNTRI Local 780 I(4) 4 scalar PTR 780,798 I Local 777 I(4) 4 scalar 804 IE Local 777 I(4) 4 scalar 788,790,791,792 IP Local 777 I(4) 4 scalar 803,804 J Local 777 I(4) 4 scalar 802,805,808 MAXVAL Func 798 scalar 798 N Local 777 I(4) 4 1 3 789,790,791,792,793,794,795 NTRI Local 788 I(4) 4 scalar PTR 788 NX Local 776 I(4) 4 scalar PTR 776,803 TRIGPTEMP Dummy 717 I(4) 4 2 1 ARG,IN 790,791,792 W3GDATMD Module 766 766 Page 24 Source Listing COUNT 2014-09-16 16:48 w3triamd.f90 811 812 SUBROUTINE COORDMAX 813 !/ ------------------------------------------------------------------- 814 !/ +-----------------------------------+ 815 !/ | WAVEWATCH III NOAA/NCEP | 816 !/ | F. Ardhuin | 817 !/ | FORTRAN 90 | 818 !/ | Last update : 15-May-2008| 819 !/ +-----------------------------------+ 820 !/ 821 !/ 15-May-2007 : Origination. ( version 3.13 ) 822 !/ 823 ! 1. Purpose : 824 ! 825 ! Calculate first point and last point coordinates, and minimum and maximum edge length. 826 ! 827 ! 2. Method : 828 ! 829 ! 3. Parameters : 830 ! 831 ! 4. Subroutines used : 832 ! 833 ! 5. Called by : 834 ! 835 ! Name Type Module Description 836 ! ---------------------------------------------------------------- 837 ! READTRI Subr. Internal Unstructured mesh definition. 838 ! ---------------------------------------------------------------- 839 ! 840 ! 6. Error messages : 841 ! 842 ! 7. Remarks : 843 ! 844 ! 8. Structure : 845 ! 846 ! 9. Switches : 847 ! 848 ! 10. Source code : 849 ! 850 !/ ------------------------------------------------------------------- / 851 USE W3GDATMD 852 IMPLICIT NONE 853 854 855 ! 856 ! maximum of coordinates s 857 ! 858 MAXX = MAXVAL(XYB(:,1)) 859 MAXY = MAXVAL(XYB(:,2)) 860 ! 861 ! minimum of coordinates 862 ! 863 X0 = MINVAL(XYB(:,1)) 864 Y0 = MINVAL(XYB(:,2)) 865 ! 866 !maximum and minimum length of edges 867 ! Page 25 Source Listing COORDMAX 2014-09-16 16:48 w3triamd.f90 868 DXYMAX = MAXVAL(LEN(:,:)) 869 SX = MINVAL(LEN(:,:)) 870 SY = SX 871 ! 872 END SUBROUTINE ENTRY POINTS Name w3triamd_mp_coordmax_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References COORDMAX Subr 812 320 DXYMAX Local 868 R(4) 4 scalar PTR 868 LEN Local 868 R(4) 4 2 1 PTR 868,869 MAXVAL Func 858 scalar 858,859,868 MAXX Local 858 R(4) 4 scalar PTR 858 MAXY Local 859 R(4) 4 scalar PTR 859 MINVAL Func 863 scalar 863,864,869 SX Local 869 R(4) 4 scalar PTR 869,870 SY Local 870 R(4) 4 scalar PTR 870 W3GDATMD Module 851 851 X0 Local 863 R(4) 4 scalar PTR 863 XYB Local 858 R(8) 8 2 1 PTR 858,859,863,864 Y0 Local 864 R(4) 4 scalar PTR 864 Page 26 Source Listing COORDMAX 2014-09-16 16:48 w3triamd.f90 873 !------------------------------------------------------------------------- 874 875 SUBROUTINE AREA_SI(IMOD) 876 !/ ------------------------------------------------------------------- 877 !/ +-----------------------------------+ 878 !/ | WAVEWATCH III NOAA/NCEP | 879 !/ | A. Roland | 880 !/ | FORTRAN 90 | 881 !/ | Last update : 23-Aug-2011| 882 !/ +-----------------------------------+ 883 !/ 884 !/ 15-May-2007 : Origination: adjustment from the WWM code ( version 3.13 ) 885 !/ 23-Aug-2011 : Removes double entries in VNEIGH ( version 4.04 ) 886 !/ 887 ! 888 ! 1. Purpose : 889 ! 890 ! Define optimized connection arrays (points and triangles) for spatial propagation schemes. 891 ! 892 ! 2. Method : 893 ! 894 ! 3. Parameters : 895 ! 896 ! 4. Subroutines used : 897 ! 898 ! 5. Called by : 899 ! 900 ! Name Type Module Description 901 ! ---------------------------------------------------------------- 902 ! READTRI Subr. Internal Unstructured mesh definition. 903 ! ---------------------------------------------------------------- 904 ! 905 ! 6. Error messages : 906 ! 907 ! 7. Remarks : 908 ! 909 ! The storage is optimize especially considering the iterative solver used. 910 ! The schemes used are vertex-centered, a point has to be considered within its 911 ! median dual cell. For a given point, the surface of the dual cell is one third 912 ! of the sum of the surface of connected triangles. 913 ! This routine is from WWM developped in Darmstadt(Aaron Roland) 914 ! 915 ! 8. Structure : 916 ! 917 ! 9. Switches : 918 ! 919 ! 10. Source code : 920 ! 921 !/ ------------------------------------------------------------------- / 922 923 USE W3GDATMD 924 IMPLICIT NONE 925 !/ input 926 927 INTEGER, INTENT(IN) :: IMOD 928 929 !/ local parameters Page 27 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 930 931 INTEGER :: COUNTER,ifound,alreadyfound 932 INTEGER :: I, J, K 933 INTEGER :: IP, IE, POS, POS_I, POS_J, POS_K, IP_I, IP_J, IP_K 934 INTEGER :: I1, I2, I3, IP2 935 INTEGER :: TMP(NX), CELLVERTEX(NX,COUNTRI,2) 936 INTEGER :: COUNT_MAX 937 DOUBLE PRECISION :: TRIA03 938 INTEGER, ALLOCATABLE :: PTABLE(:,:) 939 !DOUBLE PRECISION , PARAMETER :: ONE = 1.0d 940 !DOUBLE PRECISION , PARAMETER :: THREE = 3.0d 941 DOUBLE PRECISION, PARAMETER :: ONETHIRD = 0.33333333333333333333333333333333333333333333333 !ONETHIRD = ONE/THREE 942 !/ ------------------------------------------------------------------- / 943 944 945 SI(:) = 0. 946 ! 947 ! calculate the number of triangle connected to a point and reckon the surface of a dual cell 948 ! Ask Aron: Should be uptated with water levels ??? 949 ! 950 DO IP = 1, NX 951 COUNTER = 0 952 DO IE = 1, NTRI 953 IF (IP == TRIGP(IE,1) .OR. IP == TRIGP(IE,2) .OR. IP== TRIGP(IE,3)) THEN 954 COUNTER = COUNTER + 1 955 CCON(IP) = COUNTER 956 TRIA03 = ONETHIRD * TRIA(IE) 957 SI(IP) = SI(IP) + 1./3. * TRIA(IE) 958 END IF 959 END DO 960 END DO 961 962 CELLVERTEX(:,:,:) = 0 963 VNEIGH(:,:) = 0 964 ! 965 DO IP = 1, NX 966 COUNTER = 0 967 ifound = 0 968 ! 969 ! first step of the storage, for a given vertex, the triangle it belongs to and the vertex position 970 ! are stored 971 ! 972 DO IE = 1, NTRI 973 IF (IP == TRIGP(IE,1)) THEN 974 COUNTER = COUNTER + 1 975 CELLVERTEX(IP,COUNTER,1) = IE 976 CELLVERTEX(IP,COUNTER,2) = 1 977 DO IP2=2,3 978 alreadyfound = 0 979 DO I=1,ifound 980 IF (VNEIGH(IP,I).EQ.TRIGP(IE,IP2)) alreadyfound=alreadyfound+1 981 END DO 982 IF (alreadyfound.EQ.0) THEN 983 ifound=ifound+1 984 VNEIGH(IP,ifound)=TRIGP(IE,IP2) 985 END IF 986 END DO Page 28 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 987 END IF 988 989 IF (IP == TRIGP(IE,2)) THEN 990 COUNTER = COUNTER + 1 991 CELLVERTEX(IP,COUNTER,1) = IE 992 CELLVERTEX(IP,COUNTER,2) = 2 993 DO IP2=3,4 994 alreadyfound = 0 995 DO I=1,ifound 996 IF (VNEIGH(IP,I).EQ.TRIGP(IE,MOD(IP2-1,3)+1)) alreadyfound=alreadyfound+1 997 END DO 998 IF (alreadyfound.EQ.0) THEN 999 ifound=ifound+1 1000 VNEIGH(IP,ifound)=TRIGP(IE,MOD(IP2-1,3)+1) 1001 END IF 1002 END DO 1003 END IF 1004 1005 IF (IP == TRIGP(IE,3)) THEN 1006 COUNTER = COUNTER + 1 1007 CELLVERTEX(IP,COUNTER,1) = IE 1008 CELLVERTEX(IP,COUNTER,2) = 3 1009 DO IP2=1,2 1010 alreadyfound = 0 1011 DO I=1,ifound 1012 IF (VNEIGH(IP,I).EQ.TRIGP(IE,IP2)) alreadyfound=alreadyfound+1 1013 END DO 1014 IF (alreadyfound.EQ.0) THEN 1015 ifound=ifound+1 1016 VNEIGH(IP,ifound)=TRIGP(IE,IP2) 1017 END IF 1018 END DO 1019 END IF 1020 END DO 1021 ! 1022 ! COUNTCON is a counter on connected points. In comparison with the number of connected triangle 1023 ! CCON, it will enable to spot whether a point belong to the contour 1024 ! 1025 COUNTCON(IP)=ifound 1026 1027 do I=2,ifound 1028 do J=1,i-1 1029 if (VNEIGH(IP,J).EQ. VNEIGH(IP,I)) THEN 1030 COUNTCON(IP)=COUNTCON(IP)-1 1031 ! WRITE(993,*) 'ERROR:',IP,I,J,VNEIGH(IP,J),VNEIGH(IP,I) 1032 END IF 1033 enddo 1034 enddo 1035 1036 END DO 1037 1038 J = 0 1039 ! 1040 ! Second step in storage, the initial 3D array CELLVERTEX, is transformed in a 1D array 1041 ! the global index is J . From now, all the computation step based on these arrays must 1042 ! abide by the conservation of the 2 loop algorithm (points + connected triangles) 1043 ! AR: I will change this now to pointers in order to omit fix loop structure for the LTS stuff ... Page 29 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 1044 ! 1045 INDEX_CELL(1)=1 1046 DO IP = 1, NX 1047 DO I = 1, CCON(IP) 1048 J = J + 1 1049 IE_CELL(J) = CELLVERTEX(IP,I,1) 1050 POS_CELL(J) = CELLVERTEX(IP,I,2) 1051 END DO 1052 INDEX_CELL(IP+1)=J+1 1053 END DO 1054 1055 J = 0 1056 DO IP = 1, NX 1057 DO I = 1, CCON(IP) 1058 J = J + 1 1059 END DO 1060 END DO 1061 1062 COUNT_MAX = J 1063 1064 ALLOCATE(PTABLE(COUNT_MAX,7)) 1065 1066 J = 0 1067 PTABLE(:,:) = 0. 1068 DO IP = 1, NX 1069 DO I = 1, CCON(IP) 1070 J = J + 1 1071 IE = IE_CELL(J) 1072 POS = POS_CELL(J) 1073 I1 = TRIGP(IE,1) 1074 I2 = TRIGP(IE,2) 1075 I3 = TRIGP(IE,3) 1076 IF (POS == 1) THEN 1077 POS_J = 2 1078 POS_K = 3 1079 ELSE IF (POS == 2) THEN 1080 POS_J = 3 1081 POS_K = 1 1082 ELSE 1083 POS_J = 1 1084 POS_K = 2 1085 END IF 1086 IP_I = IP 1087 IP_J = TRIGP(IE,POS_J) 1088 IP_K = TRIGP(IE,POS_K) 1089 PTABLE(J,1) = IP_I 1090 PTABLE(J,2) = IP_J 1091 PTABLE(J,3) = IP_K 1092 PTABLE(J,4) = POS 1093 PTABLE(J,5) = POS_J 1094 PTABLE(J,6) = POS_K 1095 PTABLE(J,7) = IE 1096 END DO 1097 END DO 1098 1099 ! WRITE(*,'("+TRACE......",A)') 'SET UP SPARSE MATRIX POINTER ... COUNT NONZERO ENTRY' 1100 Page 30 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 1101 J = 0 1102 K = 0 1103 DO IP = 1, NX 1104 TMP(:) = 0 1105 DO I = 1, CCON(IP) 1106 J = J + 1 1107 IP_J = PTABLE(J,2) 1108 IP_K = PTABLE(J,3) 1109 POS = PTABLE(J,4) 1110 TMP(IP) = 1 1111 TMP(IP_J) = 1 1112 TMP(IP_K) = 1 1113 END DO 1114 K = K + SUM(TMP) 1115 END DO 1116 1117 NNZ => GRIDS(IMOD)%NNZ 1118 1119 NNZ = K 1120 1121 ! WRITE(*,'("+TRACE......",A)') 'SET UP SPARSE MATRIX POINTER ... SETUP POINTER' 1122 1123 ALLOCATE (GRIDS(IMOD)%JAA(NNZ)) 1124 ALLOCATE (GRIDS(IMOD)%IAA(NX+1)) 1125 ALLOCATE (GRIDS(IMOD)%POSI(3,COUNT_MAX)) 1126 JAA => GRIDS(IMOD)%JAA 1127 IAA => GRIDS(IMOD)%IAA 1128 POSI => GRIDS(IMOD)%POSI 1129 1130 J = 0 1131 K = 0 1132 IAA(1) = 1 1133 JAA = 0 1134 DO IP = 1, NX ! Run through all rows 1135 TMP(:)=0 1136 DO I = 1, CCON(IP) ! Check how many entries there are ... 1137 J = J + 1 ! this is the same J index as in IE_CELL 1138 IP_J = PTABLE(J,2) 1139 IP_K = PTABLE(J,3) 1140 TMP(IP) = 1 1141 TMP(IP_J) = 1 1142 TMP(IP_K) = 1 1143 END DO 1144 DO I = 1, NX ! Run through all columns 1145 IF (TMP(I) .GT. 0) THEN ! this is true only for the connected points 1146 K = K + 1 1147 JAA(K) = I 1148 END IF 1149 END DO 1150 IAA(IP + 1) = K + 1 1151 END DO 1152 1153 POSI = 0 1154 J = 0 1155 DO IP = 1, NX 1156 DO I = 1, CCON(IP) 1157 J = J + 1 Page 31 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 1158 IP_J = PTABLE(J,2) 1159 IP_K = PTABLE(J,3) 1160 DO K = IAA(IP), IAA(IP+1) - 1 1161 IF (IP == JAA(K)) POSI(1,J) = K 1162 IF (IP_J == JAA(K)) POSI(2,J) = K 1163 IF (IP_K == JAA(K)) POSI(3,J) = K 1164 IF (K == 0) THEN 1165 WRITE(*,*) 'ERROR IN AREA_SI K .EQ. 0' 1166 STOP 1167 END IF 1168 END DO 1169 END DO 1170 END DO 1171 1172 DEALLOCATE(PTABLE) 1173 1174 END SUBROUTINE ENTRY POINTS Name w3triamd_mp_area_si_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALREADYFOUND Local 931 I(4) 4 scalar 978,980,982,994,996,998,1010,1012, 1014 AREA_SI Subr 875 322 CCON Local 955 I(4) 4 1 1 PTR 955,1047,1057,1069,1105,1136,1156 CELLVERTEX Local 935 I(4) 4 3 0 962,975,976,991,992,1007,1008,1049 ,1050 COUNTCON Local 1025 I(4) 4 1 1 PTR 1025,1030 COUNTER Local 931 I(4) 4 scalar 951,954,955,966,974,975,976,990,99 1,992,1006,1007,1008 COUNTRI Local 935 I(4) 4 scalar PTR 935 COUNT_MAX Local 936 I(4) 4 scalar 1062,1064,1125 GRIDS Local 1117 RECORD 4376 1 1 ALC,TGT 1117,1123,1124,1125,1126,1127,1128 I Local 932 I(4) 4 scalar 979,980,995,996,1011,1012,1027,102 8,1029,1047,1049,1050,1057,1069,11 05,1136,1144,1145,1147,1156 I1 Local 934 I(4) 4 scalar 1073 I2 Local 934 I(4) 4 scalar 1074 I3 Local 934 I(4) 4 scalar 1075 IAA Local 1124 I(4) 4 1 1 PTR 1124,1127 IAA Local 1127 I(4) 4 1 1 PTR 1127,1132,1150,1160 IE Local 933 I(4) 4 scalar 952,953,956,957,972,973,975,980,98 4,989,991,996,1000,1005,1007,1012, 1016,1071,1073,1074,1075,1087,1088 ,1095 IE_CELL Local 1049 I(4) 4 1 1 PTR 1049,1071 IFOUND Local 931 I(4) 4 scalar 967,979,983,984,995,999,1000,1011, 1015,1016,1025,1027 Page 32 Source Listing AREA_SI 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References IMOD Dummy 875 I(4) 4 scalar ARG,IN 1117,1123,1124,1125,1126,1127,1128 INDEX_CELL Local 1045 I(4) 4 1 1 PTR 1045,1052 IP Local 933 I(4) 4 scalar 950,953,955,957,965,973,975,976,98 0,984,989,991,992,996,1000,1005,10 07,1008,1012,1016,1025,1029,1030,1 046,1047,1049,1050,1052,1056,1057, 1068,1069,1086,1103,1105,1110,1134 ,1136,1140,1150,1155,1156,1160,116 1 IP2 Local 934 I(4) 4 scalar 977,980,984,993,996,1000,1009,1012 ,1016 IP_I Local 933 I(4) 4 scalar 1086,1089 IP_J Local 933 I(4) 4 scalar 1087,1090,1107,1111,1138,1141,1158 ,1162 IP_K Local 933 I(4) 4 scalar 1088,1091,1108,1112,1139,1142,1159 ,1163 J Local 932 I(4) 4 scalar 1028,1029,1038,1048,1049,1050,1052 ,1055,1058,1062,1066,1070,1071,107 2,1089,1090,1091,1092,1093,1094,10 95,1101,1106,1107,1108,1109,1130,1 137,1138,1139,1154,1157,1158,1159, 1161,1162,1163 JAA Local 1123 I(4) 4 1 1 PTR 1123,1126 JAA Local 1126 I(4) 4 1 1 PTR 1126,1133,1147,1161,1162,1163 K Local 932 I(4) 4 scalar 1102,1114,1119,1131,1146,1147,1150 ,1160,1161,1162,1163,1164 MOD Func 996 scalar 996,1000 NNZ Local 1117 I(4) 4 scalar PTR,TGT 1117,1119,1123 NTRI Local 952 I(4) 4 scalar PTR 952,972 NX Local 935 I(4) 4 scalar PTR 935,950,965,1046,1056,1068,1103,11 24,1134,1144,1155 ONETHIRD Param 941 R(8) 8 scalar 956 POS Local 933 I(4) 4 scalar 1072,1076,1079,1092,1109 POSI Local 1125 I(4) 4 2 1 PTR 1125,1128 POSI Local 1128 I(4) 4 2 1 PTR 1128,1153,1161,1162,1163 POS_CELL Local 1050 I(4) 4 1 1 PTR 1050,1072 POS_I Local 933 I(4) 4 scalar POS_J Local 933 I(4) 4 scalar 1077,1080,1083,1087,1093 POS_K Local 933 I(4) 4 scalar 1078,1081,1084,1088,1094 PTABLE Local 938 I(4) 4 2 1 ALC 1064,1067,1089,1090,1091,1092,1093 ,1094,1095,1107,1108,1109,1138,113 9,1158,1159,1172 SI Local 945 R(4) 4 1 1 PTR 945,957 SUM Func 1114 scalar 1114 TMP Local 935 I(4) 4 1 0 1104,1110,1111,1112,1114,1135,1140 ,1141,1142,1145 TRIA Local 956 R(4) 4 1 1 PTR 956,957 TRIA03 Local 937 R(8) 8 scalar 956 TRIGP Local 953 I(4) 4 2 1 PTR 953,973,980,984,989,996,1000,1005, 1012,1016,1073,1074,1075,1087,1088 VNEIGH Local 963 I(4) 4 2 1 PTR 963,980,984,996,1000,1012,1016,102 9 W3GDATMD Module 923 923 Page 33 Source Listing AREA_SI 2014-09-16 16:48 w3triamd.f90 1175 1176 SUBROUTINE IS_IN_UNGRID_PLUS_COEFFICIENT(I, XA, YA, itout, IVER, JVER, RW) 1177 !/ ------------------------------------------------------------------- 1178 !/ +-----------------------------------+ 1179 !/ | WAVEWATCH III NOAA/NCEP | 1180 !/ | Mathieu Dutour Sikiric, IRB | 1181 !/ | Aron Roland, Z&P | 1182 !/ | FORTRAN 90 | 1183 !/ | Last update : 21-Sep-2012| 1184 !/ +-----------------------------------+ 1185 !/ 1186 !/ Adapted from other subroutine 1187 !/ 15-Oct-2007 : Origination. ( version 3.13 ) 1188 !/ 21-Sep-2012 : Uses same interpolation as regular ( version 4.08 ) 1189 !/ 1190 ! 1. Purpose : 1191 ! 1192 ! Determine whether a point is inside or outside an unstructured grid. 1193 ! 1194 ! 2. Method : 1195 ! 1196 ! Using barycentric coordinates. Each coefficient depends on the mass of its related point in the interpolation. 1197 ! 1198 ! 3. Parameters : 1199 ! 1200 ! 4. Subroutines used : 1201 ! 1202 ! 5. Called by : 1203 ! 1204 ! Name Type Module Description 1205 ! ---------------------------------------------------------------- 1206 ! W3IOPP Subr. Internal Preprocessing of point output. 1207 ! ---------------------------------------------------------------- 1208 ! 1209 ! 6. Error messages : 1210 ! 1211 ! 7. Remarks : 1212 ! 1213 ! This subroutine is adjusted from CREST code (Fabrice Ardhuin) 1214 ! For a given output point, the algorithm enable to glance through all the triangles 1215 ! to find the one the point belong to, and then make interpolation. 1216 ! 1217 ! 8. Structure : 1218 ! 1219 ! 9. Switches : 1220 ! 1221 ! !/LLG Spherical grid. 1222 ! !/XYG Carthesian grid. 1223 ! 1224 ! 10. Source code : 1225 ! 1226 !/ ------------------------------------------------------------------- / 1227 USE W3GDATMD 1228 USE W3SERVMD, ONLY: EXTCDE 1229 USE W3ODATMD, ONLY: NDSE 1230 IMPLICIT NONE 1231 Page 34 Source Listing IS_IN_UNGRID_PLUS_COEFFICIENT 2014-09-16 16:48 w3triamd.f90 1232 !/ ------------------------------------------------------------------- / 1233 ! Parameter list 1234 1235 INTEGER, INTENT(IN) :: I 1236 REAL , INTENT(IN) :: XA, YA 1237 INTEGER, INTENT(OUT) :: itout 1238 INTEGER, INTENT(OUT) :: IVER(4), JVER(4) 1239 REAL, INTENT(OUT) :: RW(4) 1240 !/ ------------------------------------------------------------------- / 1241 !local parameters 1242 1243 DOUBLE PRECISION :: x1, x2, x3, xg 1244 DOUBLE PRECISION :: y1, y2, y3, yg 1245 DOUBLE PRECISION :: xx1, xx2, xx3, xx 1246 DOUBLE PRECISION :: yy1, yy2, yy3, yy 1247 DOUBLE PRECISION :: d1, d2, d3 1248 DOUBLE PRECISION :: dM1, dM2, dM3 1249 DOUBLE PRECISION :: sg1, sg2, sg3 1250 DOUBLE PRECISION :: s1, s2, s3 1251 DOUBLE PRECISION :: delta 1252 INTEGER :: ITRI 1253 INTEGER :: I1, I2, I3 1254 INTEGER :: nbFound 1255 1256 ! 1257 itout = 0 1258 nbFound=0 1259 DO ITRI= 1, GRIDS(I)%NTRI 1260 I1=GRIDS(I)%TRIGP(ITRI,1) 1261 I2=GRIDS(I)%TRIGP(ITRI,2) 1262 I3=GRIDS(I)%TRIGP(ITRI,3) 1263 ! coordinates of the first vertex A 1264 x1=GRIDS(I)%XYB(I1,1) 1265 y1=GRIDS(I)%XYB(I1,2) 1266 ! coordinates of the 2nd vertex B 1267 x2=GRIDS(I)%XYB(I2,1) 1268 y2=GRIDS(I)%XYB(I2,2) 1269 !coordinates of the 3rd vertex C 1270 x3=GRIDS(I)%XYB(I3,1) 1271 y3=GRIDS(I)%XYB(I3,2) 1272 ! coordinates of center of gravity G 1273 xg=(x1+x2+x3)/3. 1274 yg=(y1+y2+y3)/3. 1275 !length of edges 1276 d1=sqrt((y2-y3)**2+(x2-x3)**2) 1277 d2=sqrt((y3-y1)**2+(x3-x1)**2) 1278 d3=sqrt((y2-y1)**2+(x2-x1)**2) 1279 !evaluate length between the vertices and the output point 1280 dM1=sqrt((YA-y1)**2+(XA-x1)**2) 1281 dM2=sqrt((YA-y2)**2+(XA-x2)**2) 1282 dM3=sqrt((YA-y3)**2+(XA-x3)**2) 1283 ! 1284 IF (dM1 > dM2) THEN 1285 !vector product of AB and AG 1286 sg1=(yg-y1)*(x2-x1)-(xg-x1)*(y2-y1) 1287 !vector product of AB and AM 1288 s1=(YA-y1)*(x2-x1)-(XA-x1)*(y2-y1) Page 35 Source Listing IS_IN_UNGRID_PLUS_COEFFICIENT 2014-09-16 16:48 w3triamd.f90 1289 ELSE 1290 !vector product of BA and BG 1291 sg1=(yg-y2)*(x1-x2)-(xg-x2)*(y1-y2) 1292 !vector product of BA and BM 1293 s1=(YA-y2)*(x1-x2)-(XA-x2)*(y1-y2) 1294 END IF 1295 IF (dM2 > dM3) THEN 1296 !vector product of BC and BG 1297 sg2=(yg-y2)*(x3-x2)-(xg-x2)*(y3-y2) 1298 !vector product of BC and BM 1299 s2=(YA-y2)*(x3-x2)-(XA-x2)*(y3-y2) 1300 ELSE 1301 !vector product of CB and CG 1302 sg2=(yg-y3)*(x2-x3)-(xg-x3)*(y2-y3) 1303 !vector product of CB and CM 1304 s2=(YA-y3)*(x2-x3)-(XA-x3)*(y2-y3) 1305 END IF 1306 IF (dM3 > dM1) THEN 1307 !vector product of CA and CG 1308 sg3=(yg-y3)*(x1-x3)-(xg-x3)*(y1-y3) 1309 !vector product of CA and CM 1310 s3=(YA-y3)*(x1-x3)-(XA-x3)*(y1-y3) 1311 ELSE 1312 !vector product of AC and AG 1313 sg3=(yg-y1)*(x3-x1)-(xg-x1)*(y3-y1) 1314 !vector product of AC and AM 1315 s3=(YA-y1)*(x3-x1)-(XA-x1)*(y3-y1) 1316 END IF 1317 IF ((s1*sg1.GE.0).AND.(s2*sg2.GE.0).AND.(s3*sg3.GE.0)) THEN 1318 itout=ITRI 1319 nbFound=nbFound+1 1320 IVER(1)=I1 1321 IVER(2)=I2 1322 IVER(3)=I3 1323 IVER(4)=0 1324 JVER(1)=1 1325 JVER(2)=1 1326 JVER(3)=1 1327 JVER(4)=0 1328 RW(1)=s1/sg1 1329 RW(2)=s2/sg2 1330 RW(3)=s3/sg3 1331 RW(4)=0 1332 END IF 1333 ENDDO 1334 1335 1336 END SUBROUTINE IS_IN_UNGRID_PLUS_COEFFICIENT Page 36 Source Listing IS_IN_UNGRID_PLUS_COEFFICIENT 2014-09-16 16:48 Entry Points w3triamd.f90 ENTRY POINTS Name w3triamd_mp_is_in_ungrid_plus_coefficient_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References D1 Local 1247 R(8) 8 scalar 1276 D2 Local 1247 R(8) 8 scalar 1277 D3 Local 1247 R(8) 8 scalar 1278 DELTA Local 1251 R(8) 8 scalar DM1 Local 1248 R(8) 8 scalar 1280,1284,1306 DM2 Local 1248 R(8) 8 scalar 1281,1284,1295 DM3 Local 1248 R(8) 8 scalar 1282,1295,1306 EXTCDE Subr 1228 1228 GRIDS Local 1259 RECORD 4376 1 1 ALC,TGT 1259,1260,1261,1262,1264,1265,1267 ,1268,1270,1271 I Dummy 1176 I(4) 4 scalar ARG,IN 1259,1260,1261,1262,1264,1265,1267 ,1268,1270,1271 I1 Local 1253 I(4) 4 scalar 1260,1264,1265,1320 I2 Local 1253 I(4) 4 scalar 1261,1267,1268,1321 I3 Local 1253 I(4) 4 scalar 1262,1270,1271,1322 IS_IN_UNGRID_PLUS_COEFFICI ENT Subr 1176 ITOUT Dummy 1176 I(4) 4 scalar ARG,OUT 1257,1318 ITRI Local 1252 I(4) 4 scalar 1259,1260,1261,1262,1318 IVER Dummy 1176 I(4) 4 1 4 ARG,OUT 1320,1321,1322,1323 JVER Dummy 1176 I(4) 4 1 4 ARG,OUT 1324,1325,1326,1327 NBFOUND Local 1254 I(4) 4 scalar 1258,1319 NDSE Local 1229 I(4) 4 scalar PTR 1229 NTRI Local 1259 I(4) 4 scalar 1259 RW Dummy 1176 R(4) 4 1 4 ARG,OUT 1328,1329,1330,1331 S1 Local 1250 R(8) 8 scalar 1288,1293,1317,1328 S2 Local 1250 R(8) 8 scalar 1299,1304,1317,1329 S3 Local 1250 R(8) 8 scalar 1310,1315,1317,1330 SG1 Local 1249 R(8) 8 scalar 1286,1291,1317,1328 SG2 Local 1249 R(8) 8 scalar 1297,1302,1317,1329 SG3 Local 1249 R(8) 8 scalar 1308,1313,1317,1330 SQRT Func 1276 scalar 1276,1277,1278,1280,1281,1282 TRIGP Local 1260 I(4) 4 2 1 PTR 1260,1261,1262 W3GDATMD Module 1227 1227 W3ODATMD Module 1229 1229 W3SERVMD Module 1228 1228 X1 Local 1243 R(8) 8 scalar 1264,1273,1277,1278,1280,1286,1288 ,1291,1293,1308,1310,1313,1315 X2 Local 1243 R(8) 8 scalar 1267,1273,1276,1278,1281,1286,1288 ,1291,1293,1297,1299,1302,1304 X3 Local 1243 R(8) 8 scalar 1270,1273,1276,1277,1282,1297,1299 ,1302,1304,1308,1310,1313,1315 XA Dummy 1176 R(4) 4 scalar ARG,IN 1280,1281,1282,1288,1293,1299,1304 ,1310,1315 Page 37 Source Listing IS_IN_UNGRID_PLUS_COEFFICIENT 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References XG Local 1243 R(8) 8 scalar 1273,1286,1291,1297,1302,1308,1313 XX Local 1245 R(8) 8 scalar XX1 Local 1245 R(8) 8 scalar XX2 Local 1245 R(8) 8 scalar XX3 Local 1245 R(8) 8 scalar XYB Local 1264 R(8) 8 2 1 PTR 1264,1265,1267,1268,1270,1271 Y1 Local 1244 R(8) 8 scalar 1265,1274,1277,1278,1280,1286,1288 ,1291,1293,1308,1310,1313,1315 Y2 Local 1244 R(8) 8 scalar 1268,1274,1276,1278,1281,1286,1288 ,1291,1293,1297,1299,1302,1304 Y3 Local 1244 R(8) 8 scalar 1271,1274,1276,1277,1282,1297,1299 ,1302,1304,1308,1310,1313,1315 YA Dummy 1176 R(4) 4 scalar ARG,IN 1280,1281,1282,1288,1293,1299,1304 ,1310,1315 YG Local 1244 R(8) 8 scalar 1274,1286,1291,1297,1302,1308,1313 YY Local 1246 R(8) 8 scalar YY1 Local 1246 R(8) 8 scalar YY2 Local 1246 R(8) 8 scalar YY3 Local 1246 R(8) 8 scalar Page 38 Source Listing IS_IN_UNGRID_PLUS_COEFFICIENT 2014-09-16 16:48 w3triamd.f90 1337 1338 1339 1340 !/ ------------------------------------------------------------------- / 1341 1342 SUBROUTINE IS_IN_UNGRID_INTERP(IPT, XPT, YPT, itout, IVER, JVER, RD) 1343 1344 !/ ------------------------------------------------------------------- 1345 !/ +-----------------------------------+ 1346 !/ | WAVEWATCH III NOAA/NCEP | 1347 !/ | F. Ardhuin | 1348 !/ | FORTRAN 90 | 1349 !/ | Last update : 01-Sep-2012| 1350 !/ +-----------------------------------+ 1351 !/ 1352 !/ 15-Oct-2007 : Origination. ( version 3.13 ) 1353 !/ 21-Sep-2012 : Uses same interpolation as regular ( version 4.08 ) 1354 !/ 1355 ! 1. Purpose : 1356 ! 1357 ! Calculate interpolation coefficient for fields on the unstructured grid. 1358 ! 1359 ! 2. Method : 1360 ! 1361 ! Using barycentric coordinates. Each coefficient depends on the mass of its related point in the interpolation. 1362 ! 1363 ! 3. Parameters : 1364 ! 1365 ! 4. Subroutines used : 1366 ! 1367 ! 5. Called by : 1368 ! 1369 ! Name Type Module Description 1370 ! ---------------------------------------------------------------- 1371 ! W3IOPP Subr. Internal Preprocessing of point output. 1372 ! ---------------------------------------------------------------- 1373 ! 1374 ! 6. Error messages : 1375 ! 1376 ! 7. Remarks : 1377 ! 1378 ! This subroutine is adjusted from CREST code (Fabrice Ardhuin) 1379 ! For a given output point, the algorithm enable to glance through all the triangles 1380 ! to find the one the point belong to, and then make interpolation. 1381 ! 1382 ! 8. Structure : 1383 ! 1384 ! 9. Switches : 1385 ! 1386 ! 10. Source code : 1387 ! 1388 !/ ------------------------------------------------------------------- / 1389 1390 USE W3GDATMD, ONLY : TRIGP, NTRI, XYB, MAPSTA 1391 USE W3SERVMD, ONLY: EXTCDE 1392 USE W3ODATMD, ONLY: NDSE 1393 IMPLICIT NONE Page 39 Source Listing IS_IN_UNGRID_INTERP 2014-09-16 16:48 w3triamd.f90 1394 1395 !/ ------------------------------------------------------------------- / 1396 ! Parameter list 1397 1398 INTEGER, INTENT(IN) :: IPT 1399 REAL , INTENT(IN) :: XPT(:), YPT(:) 1400 INTEGER, INTENT(OUT) :: itout 1401 INTEGER, INTENT(OUT) :: IVER(4), JVER(4) 1402 REAL, INTENT(OUT) :: RD(4) 1403 !/ ------------------------------------------------------------------- / 1404 !local parameters 1405 1406 DOUBLE PRECISION :: x1, x2, x3, x 1407 DOUBLE PRECISION :: y1, y2, y3, y 1408 DOUBLE PRECISION :: dM1, dM2, dM3 1409 DOUBLE PRECISION :: sg1, sg2, sg3 1410 DOUBLE PRECISION :: s1, s2, s3 1411 INTEGER :: ITRI, I, J, K 1412 1413 ! 1414 itout = 0 1415 ! 1416 ! coordinates of the output point 1417 ! 1418 x=DBLE(XPT(IPT)) 1419 y=DBLE(YPT(IPT)) 1420 DO ITRI= 1, NTRI 1421 ! coordinates of the first vertex A 1422 x1=XYB(TRIGP(ITRI,1),1) 1423 y1=XYB(TRIGP(ITRI,1),2) 1424 ! coordinates of the 2nd vertex B 1425 x2=XYB(TRIGP(ITRI,2),1) 1426 y2=XYB(TRIGP(ITRI,2),2) 1427 !coordinates of the 3rd vertex C 1428 x3=XYB(TRIGP(ITRI,3),1) 1429 y3=XYB(TRIGP(ITRI,3),2) 1430 !evaluate squared length between the vertices and the output point 1431 dM1=(y-y1)**2+(x-x1)**2 1432 dM2=(y-y2)**2+(x-x2)**2 1433 dM3=(y-y3)**2+(x-x3)**2 1434 ! 1435 IF (dM2 > dM3) THEN 1436 !vector product of BC and BA 1437 sg1=(y1-y2)*(x3-x2)-(x1-x2)*(y3-y2) 1438 !vector product of BC and BM 1439 s1= (y -y2)*(x3-x2)-(x -x2)*(y3-y2) 1440 ELSE 1441 !vector product of CB and CA 1442 sg1=(y1-y3)*(x2-x3)-(x1-x3)*(y2-y3) 1443 !vector product of CB and CM 1444 s1= (y -y3)*(x2-x3)-(x -x3)*(y2-y3) 1445 END IF 1446 IF (dM3 > dM1) THEN 1447 !vector product of CA and CB 1448 sg2=(y2-y3)*(x1-x3)-(x2-x3)*(y1-y3) 1449 !vector product of CA and CM 1450 s2= (y -y3)*(x1-x3)-(x -x3)*(y1-y3) Page 40 Source Listing IS_IN_UNGRID_INTERP 2014-09-16 16:48 w3triamd.f90 1451 ELSE 1452 !vector product of AC and AB 1453 sg2=(y2-y1)*(x3-x1)-(x2-x1)*(y3-y1) 1454 !vector product of AC and AM 1455 s2= (y-y1) *(x3-x1)-(x-x1) *(y3-y1) 1456 END IF 1457 IF (dM1 > dM2) THEN 1458 !vector product of AB and AC 1459 sg3=(y3-y1)*(x2-x1)-(x3-x1)*(y2-y1) 1460 !vector product of AB and AM 1461 s3= (y-y1) *(x2-x1)-(x-x1) *(y2-y1) 1462 ELSE 1463 !vector product of BA and BC 1464 sg3=(y3-y2)*(x1-x2)-(x3-x2)*(y1-y2) 1465 !vector product of BA and BM 1466 s3= (y-y2) *(x1-x2)-(x-x2) *(y1-y2) 1467 END IF 1468 ! test if the point is within the triangle 1469 IF ((s1*sg1.GE.0).AND.(s2*sg2.GE.0).AND.(s3*sg3.GE.0)) THEN 1470 itout=ITRI 1471 IVER(1)=TRIGP(ITRI,1) 1472 IVER(2)=TRIGP(ITRI,2) 1473 IVER(3)=TRIGP(ITRI,3) 1474 IVER(4)=TRIGP(ITRI,1) 1475 JVER(:)=1 1476 RD(1)=s1/sg1 ! this is the ratio of triangles areas MBC / ABC 1477 RD(2)=s2/sg2 ! this is the ratio of triangles areas MAC / ABC 1478 RD(3)=1.-RD(1)-RD(2) 1479 RD(4)=0 1480 !PRINT*,'TRI TEST:',ITOUT 1481 !PRINT*, TRIGP(ITOUT,1:3) 1482 !PRINT*, IVER 1483 !PRINT*, RD 1484 !PRINT*, x1,x2,x3,x 1485 !PRINT*, y1,y2,y3,y 1486 !PRINT*, sg1,s1,sg2,s2,sg3,s3 1487 END IF 1488 END DO 1489 ! * 1490 RETURN 1491 END SUBROUTINE IS_IN_UNGRID_INTERP Page 41 Source Listing IS_IN_UNGRID_INTERP 2014-09-16 16:48 Entry Points w3triamd.f90 ENTRY POINTS Name w3triamd_mp_is_in_ungrid_interp_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References DBLE Func 1418 scalar 1418,1419 DM1 Local 1408 R(8) 8 scalar 1431,1446,1457 DM2 Local 1408 R(8) 8 scalar 1432,1435,1457 DM3 Local 1408 R(8) 8 scalar 1433,1435,1446 EXTCDE Subr 1391 1391 I Local 1411 I(4) 4 scalar IPT Dummy 1342 I(4) 4 scalar ARG,IN 1418,1419 IS_IN_UNGRID_INTERP Subr 1342 ITOUT Dummy 1342 I(4) 4 scalar ARG,OUT 1414,1470 ITRI Local 1411 I(4) 4 scalar 1420,1422,1423,1425,1426,1428,1429 ,1470,1471,1472,1473,1474 IVER Dummy 1342 I(4) 4 1 4 ARG,OUT 1471,1472,1473,1474 J Local 1411 I(4) 4 scalar JVER Dummy 1342 I(4) 4 1 4 ARG,OUT 1475 K Local 1411 I(4) 4 scalar MAPSTA Local 1390 I(4) 4 2 1 PTR 1390 NDSE Local 1392 I(4) 4 scalar PTR 1392 NTRI Local 1390 I(4) 4 scalar PTR 1390,1420 RD Dummy 1342 R(4) 4 1 4 ARG,OUT 1476,1477,1478,1479 S1 Local 1410 R(8) 8 scalar 1439,1444,1469,1476 S2 Local 1410 R(8) 8 scalar 1450,1455,1469,1477 S3 Local 1410 R(8) 8 scalar 1461,1466,1469 SG1 Local 1409 R(8) 8 scalar 1437,1442,1469,1476 SG2 Local 1409 R(8) 8 scalar 1448,1453,1469,1477 SG3 Local 1409 R(8) 8 scalar 1459,1464,1469 TRIGP Local 1390 I(4) 4 2 1 PTR 1390,1422,1423,1425,1426,1428,1429 ,1471,1472,1473,1474 W3GDATMD Module 1390 1390 W3ODATMD Module 1392 1392 W3SERVMD Module 1391 1391 X Local 1406 R(8) 8 scalar 1418,1431,1432,1433,1439,1444,1450 ,1455,1461,1466 X1 Local 1406 R(8) 8 scalar 1422,1431,1437,1442,1448,1450,1453 ,1455,1459,1461,1464,1466 X2 Local 1406 R(8) 8 scalar 1425,1432,1437,1439,1442,1444,1448 ,1453,1459,1461,1464,1466 X3 Local 1406 R(8) 8 scalar 1428,1433,1437,1439,1442,1444,1448 ,1450,1453,1455,1459,1464 XPT Dummy 1342 R(4) 4 1 1 ARG,IN 1418 XYB Local 1390 R(8) 8 2 1 PTR 1390,1422,1423,1425,1426,1428,1429 Y Local 1407 R(8) 8 scalar 1419,1431,1432,1433,1439,1444,1450 ,1455,1461,1466 Y1 Local 1407 R(8) 8 scalar 1423,1431,1437,1442,1448,1450,1453 ,1455,1459,1461,1464,1466 Page 42 Source Listing IS_IN_UNGRID_INTERP 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References Y2 Local 1407 R(8) 8 scalar 1426,1432,1437,1439,1442,1444,1448 ,1453,1459,1461,1464,1466 Y3 Local 1407 R(8) 8 scalar 1429,1433,1437,1439,1442,1444,1448 ,1450,1453,1455,1459,1464 YPT Dummy 1342 R(4) 4 1 1 ARG,IN 1419 Page 43 Source Listing IS_IN_UNGRID_INTERP 2014-09-16 16:48 w3triamd.f90 1492 !/ ------------------------------------------------------------------- / 1493 SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) 1494 !/ +-----------------------------------+ 1495 !/ | WAVEWATCH III NOAA/NCEP | 1496 !/ | F. Ardhuin | 1497 !/ | FORTRAN 90 | 1498 !/ | Last update : 14-Oct-2013| 1499 !/ +-----------------------------------+ 1500 !/ 1501 !/ 15-Nov-2007 : Origination. ( version 3.13 ) 1502 !/ 31-Oct-2010 : Merging of 4.03 with 3.14-Ifremer ( version 4.04 ) 1503 !/ 08-Nov-2011 : Correction for zero grad. on contour( version 4.04 ) 1504 !/ 14-Oct-2013 : Correction of latitude factor ( version 4.12 ) 1505 !/ 1506 ! 1507 ! 1. purpose: calculate gradients at a point via its connection. 1508 ! 2. Method : using 3D plan definition and angular redistribution 1509 ! 1510 ! 3. Parameters : 1511 ! PARAM : depth or current field (indices 0 to NSEA) 1512 ! DIFFX : x gradient (indices 1 to NX) 1513 ! DIFFY : y gradient (indices 1 to NX) 1514 ! 1515 ! 4. Subroutines used : 1516 ! 1517 ! 5. Called by : 1518 ! 1519 ! Name Type Module Description 1520 ! ---------------------------------------------------------------- 1521 ! W3WAVE Subr. Actual wind wave routine 1522 ! ---------------------------------------------------------------- 1523 ! 1524 ! 6. Error messages : 1525 ! 1526 ! 7. Remarks : 1527 ! 1528 ! This subroutine is adjusted from WWM code (Aaron Roland) 1529 1530 ! 1531 ! 8. Structure : 1532 ! 1533 ! 9. Switches : 1534 ! 1535 ! 10. Source code : 1536 USE CONSTANTS 1537 USE W3GDATMD, ONLY : CROSSDIFF, TRIGP, NTRI, NX, NSEA, MAPFS, CLATIS, & 1538 MAPSTA, ANGLE, FLAGLL, IOBP 1539 IMPLICIT NONE 1540 1541 1542 REAL, INTENT(IN) :: PARAM(0:NSEA) 1543 REAL, INTENT(OUT) :: DIFFX(:,:), DIFFY(:,:) 1544 1545 ! local parameters 1546 1547 INTEGER :: VERTICES(3) 1548 INTEGER :: COUNTER(NX) Page 44 Source Listing UG_GRADIENTS 2014-09-16 16:48 w3triamd.f90 1549 REAL :: TMP1(3), TMP2(3) 1550 INTEGER :: I, IX 1551 REAL :: VAR(3), FACT, LATMEAN 1552 REAL :: DIFFXTMP, DIFFYTMP 1553 REAL, PARAMETER :: ONETHIRD = 0.3333333333 1554 1555 !initialisation step 1556 COUNTER(:) = 0. 1557 DIFFX(:,:) = 0. 1558 DIFFY(:,:) = 0. 1559 ! 1560 IF (FLAGLL) THEN 1561 FACT=1./(DERA*RADIUS) 1562 ELSE 1563 FACT=1. 1564 END IF 1565 DO I = 1, NTRI 1566 VERTICES(1) = TRIGP(I,1) 1567 VERTICES(2) = TRIGP(I,2) 1568 VERTICES(3) = TRIGP(I,3) 1569 ! 1570 ! CLATIS is 1/COS(latitute) 1571 ! this may give funny results close to the pole ... 1572 ! 1573 LATMEAN = ONETHIRD * ( CLATIS(MAPFS(1,VERTICES(1))) & 1574 +CLATIS(MAPFS(1,VERTICES(2))) & 1575 +CLATIS(MAPFS(1,VERTICES(3))) ) 1576 1577 VAR(1) = PARAM(MAPFS(1,VERTICES(1)))* FACT 1578 VAR(2) = PARAM(MAPFS(1,VERTICES(2)))* FACT 1579 VAR(3) = PARAM(MAPFS(1,VERTICES(3)))* FACT 1580 1581 TMP1(:) = CROSSDIFF(1:3, I) 1582 TMP2(:) = CROSSDIFF(4:6, I) 1583 1584 ! Slopes in a triangle : 1585 ! denom=(x(1)-x(2))*(y(3)-y(2))-(y(2)-y(1))*(x(2)-x(3)); 1586 ! denom is 2*area 1587 !dz/dy= -((z(2)-z(1))*(x(2)-x(3))-(z(3)-z(2))*(x(1)-x(2)))/denom; 1588 !dz/dx= ((z(2)-z(1))*(y(2)-y(3))+(z(3)-z(2))*(y(1)-y(2)))/denom; 1589 !dz/dx= (z(1)*(y(3)-y(2))+z(2)*(y(1)-y(3))+z(3)*(y(2)-y(1)))/(2*area); 1590 !dz/dy= -(z(1)*(x(3)-x(2))+z(2)*(x(1)-x(3))+z(3)*(x(2)-x(1)))/(2*area); 1591 1592 DIFFXTMP = DOT_PRODUCT(VAR(:),TMP1(:)) * LATMEAN 1593 DIFFYTMP = DOT_PRODUCT(VAR(:),TMP2(:)) 1594 1595 ! calculate global gradients via all the connection contributions. 1596 DIFFX(1,VERTICES(:)) = DIFFX(1,VERTICES(:)) + DIFFXTMP * ANGLE(I,:) 1597 DIFFY(1,VERTICES(:)) = DIFFY(1,VERTICES(:)) + DIFFYTMP * ANGLE(I,:) 1598 END DO 1599 ! 1600 ! Sets gradient to 0 on the contour 1601 ! 1602 DO IX = 1,NX 1603 IF (IOBP(IX).EQ. 0 ) THEN 1604 DIFFX(1,IX) = 0. 1605 DIFFY(1,IX) = 0. Page 45 Source Listing UG_GRADIENTS 2014-09-16 16:48 w3triamd.f90 1606 END IF 1607 END DO 1608 ! 1609 END SUBROUTINE UG_GRADIENTS ENTRY POINTS Name w3triamd_mp_ug_gradients_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ANGLE Local 1538 R(4) 4 2 1 PTR 1538,1596,1597 CLATIS Local 1537 R(4) 4 1 1 PTR 1537,1573,1574,1575 CONSTANTS Module 1536 1536 COUNTER Local 1548 I(4) 4 1 0 1556 CROSSDIFF Local 1537 R(4) 4 2 1 PTR 1537,1581,1582 DERA Param 1561 R(4) 4 scalar 1561 DIFFX Dummy 1493 R(4) 4 2 1 ARG,OUT 1557,1596,1604 DIFFXTMP Local 1552 R(4) 4 scalar 1592,1596 DIFFY Dummy 1493 R(4) 4 2 1 ARG,OUT 1558,1597,1605 DIFFYTMP Local 1552 R(4) 4 scalar 1593,1597 DOT_PRODUCT Func 1592 scalar 1592,1593 FACT Local 1551 R(4) 4 scalar 1561,1563,1577,1578,1579 FLAGLL Local 1538 L(4) 4 scalar 1538,1560 I Local 1550 I(4) 4 scalar 1565,1566,1567,1568,1581,1582,1596 ,1597 IOBP Local 1538 I(4) 4 1 1 PTR 1538,1603 IX Local 1550 I(4) 4 scalar 1602,1603,1604,1605 LATMEAN Local 1551 R(4) 4 scalar 1573,1592 MAPFS Local 1537 I(4) 4 2 1 PTR 1537,1573,1574,1575,1577,1578,1579 MAPSTA Local 1538 I(4) 4 2 1 PTR 1538 NSEA Local 1537 I(4) 4 scalar PTR 1537,1542 NTRI Local 1537 I(4) 4 scalar PTR 1537,1565 NX Local 1537 I(4) 4 scalar PTR 1537,1548,1602 ONETHIRD Param 1553 R(4) 4 scalar 1573 PARAM Dummy 1493 R(4) 4 1 0 ARG,IN 1577,1578,1579 RADIUS Param 1561 R(4) 4 scalar 1561 TMP1 Local 1549 R(4) 4 1 3 1581,1592 TMP2 Local 1549 R(4) 4 1 3 1582,1593 TRIGP Local 1537 I(4) 4 2 1 PTR 1537,1566,1567,1568 UG_GRADIENTS Subr 1493 VAR Local 1551 R(4) 4 1 3 1577,1578,1579,1592,1593 VERTICES Local 1547 I(4) 4 1 3 1566,1567,1568,1573,1574,1575,1577 ,1578,1579,1596,1597 W3GDATMD Module 1537 1537 Page 46 Source Listing UG_GRADIENTS 2014-09-16 16:48 w3triamd.f90 1610 !/ ------------------------------------------------------------------- / 1611 SUBROUTINE W3NESTUG(DISTMIN,FLOK) 1612 USE W3ODATMD, ONLY: NBI, NDSE, ISBPI, XBPI, YBPI 1613 USE W3GDATMD, ONLY: NX, XYB, XGRD, YGRD, MAPSTA, MAPFS, MAPSF 1614 1615 1616 REAL, INTENT(IN) :: DISTMIN 1617 LOGICAL, INTENT(INOUT) :: FLOK 1618 1619 INTEGER :: I, J, JMEMO, IS, IX, N, IX1(NBI) 1620 REAL :: DIST, DIST0 1621 ! 1622 N = 0 1623 ! 1624 !1. look for input boundary point index 1625 ! warning: if land points are included as boundary points to abide by the nest 1626 ! file, their status should be -2. 1627 ! 1628 IX1 = 0 1629 ISBPI = 1 1630 DO IX = 1, NX 1631 IF (ABS(MAPSTA (1,IX)) .EQ. 2) THEN 1632 N = N + 1 1633 IF (N.GT.NBI) THEN 1634 WRITE(NDSE,*) 'Error: boundary node index > NBI ... nest.ww3 file is not consistent with mod_def.ww3' 1635 STOP 1636 ENDIF 1637 IX1(N) = IX 1638 END IF 1639 END DO 1640 ! 1641 !2. Matches the model grid points (where MAPSTA = 2) with the points in nest.ww3 1642 ! For this, we use the nearest point in the nest file. 1643 ! 1644 DO I = 1, NBI 1645 !FA: This will not work with FLAGLL=.F. (XY grid) 1646 DIST0 = 360**2 1647 IS=1 1648 DO J = 1, N 1649 DIST=(XBPI(I)-XYB(IX1(J),1))**2+(YBPI(I)-XYB(IX1(J),2))**2 1650 IF (DIST.LT.DIST0) THEN 1651 IS = MAPFS(1,IX1(J)) 1652 DIST0=DIST 1653 JMEMO=J 1654 END IF 1655 END DO 1656 DIST0=SQRT(DIST0) 1657 IF (DIST0.LE.DISTMIN) THEN 1658 ISBPI(I)=IS 1659 ELSE 1660 FLOK=.TRUE. 1661 END IF 1662 END DO 1663 IF ( N .NE. NBI) THEN 1664 WRITE(NDSE ,900) N, NBI 1665 DO J=1,N 1666 WRITE(6,*) 'THIS POINT HAS MAPSTA=2:',ISBPI(J) Page 47 Source Listing W3NESTUG 2014-09-16 16:48 w3triamd.f90 1667 END DO 1668 ISBPI(N+1:NBI)=ISBPI(1) 1669 END IF 1670 1671 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/ & 1672 ' NUMBER OF MAPSTA=2 DIFFERS FROM NUMBER IN nest.ww3 '/ & 1673 ' CHECK nest.ww3 AND ww3_grid.inp ',2I8/) 1674 END SUBROUTINE ENTRY POINTS Name w3triamd_mp_w3nestug_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 900 Label 1671 1664 ABS Func 1631 scalar 1631 DIST Local 1620 R(4) 4 scalar 1649,1650,1652 DIST0 Local 1620 R(4) 4 scalar 1646,1650,1652,1656,1657 DISTMIN Dummy 1611 R(4) 4 scalar ARG,IN 1657 FLOK Dummy 1611 L(4) 4 scalar ARG,INOUT 1660 I Local 1619 I(4) 4 scalar 1644,1649,1658 IS Local 1619 I(4) 4 scalar 1647,1651,1658 ISBPI Local 1612 I(4) 4 1 1 PTR 1612,1629,1658,1666,1668 IX Local 1619 I(4) 4 scalar 1630,1631,1637 IX1 Local 1619 I(4) 4 1 0 1628,1637,1649,1651 J Local 1619 I(4) 4 scalar 1648,1649,1651,1653,1665,1666 JMEMO Local 1619 I(4) 4 scalar 1653 MAPFS Local 1613 I(4) 4 2 1 PTR 1613,1651 MAPSF Local 1613 I(4) 4 2 1 PTR 1613 MAPSTA Local 1613 I(4) 4 2 1 PTR 1613,1631 N Local 1619 I(4) 4 scalar 1622,1632,1633,1637,1648,1663,1664 ,1665,1668 NBI Local 1612 I(4) 4 scalar PTR 1612,1619,1633,1644,1663,1664,1668 NDSE Local 1612 I(4) 4 scalar PTR 1612,1634,1664 NX Local 1613 I(4) 4 scalar PTR 1613,1630 SQRT Func 1656 scalar 1656 W3GDATMD Module 1613 1613 W3NESTUG Subr 1611 W3ODATMD Module 1612 1612 XBPI Local 1612 R(4) 4 1 1 PTR 1612,1649 XGRD Local 1613 R(4) 4 2 1 PTR 1613 XYB Local 1613 R(8) 8 2 1 PTR 1613,1649 YBPI Local 1612 R(4) 4 1 1 PTR 1612,1649 YGRD Local 1613 R(4) 4 2 1 PTR 1613 Page 48 Source Listing W3NESTUG 2014-09-16 16:48 w3triamd.f90 1675 1676 !/ ------------------------------------------------------------------- / 1677 SUBROUTINE SETUGIOBP ( ) 1678 !/ 1679 !/ +-----------------------------------+ 1680 !/ | WAVEWATCH III NOAA/NCEP | 1681 !/ | Fabrice Ardhuin | 1682 !/ | FORTRAN 90 | 1683 !/ | Last update : 23-Aug-2011 | 1684 !/ +-----------------------------------+ 1685 !/ 1686 !/ 23-Aug-2011 : Origination. ( version 4.04 ) 1687 !/ 1688 ! 1. Purpose : 1689 ! 1690 ! Redefines the values of the boundary points and angle pointers 1691 ! based on the MAPSTA array 1692 ! 1693 ! 2. Method : 1694 ! 1695 ! 3. Parameters : 1696 ! 1697 ! Parameter list 1698 ! ---------------------------------------------------------------- 1699 ! ---------------------------------------------------------------- 1700 ! 1701 ! Local variables. 1702 ! ---------------------------------------------------------------- 1703 ! ---------------------------------------------------------------- 1704 ! 1705 ! 4. Subroutines used : 1706 ! 1707 1708 ! 5. Called by : 1709 ! 1710 ! Name Type Module Description 1711 ! ---------------------------------------------------------------- 1712 ! WW3_GRID Prog. WW3_GRID Grid preprocessor 1713 ! W3ULEV Subr. W3UPDTMD Water level update 1714 ! ---------------------------------------------------------------- 1715 ! 1716 ! 6. Error messages : 1717 ! 1718 ! None. 1719 ! 1720 ! 7. Remarks : 1721 ! 1722 ! 8. Structure : 1723 ! 1724 ! 9. Switches : 1725 ! 1726 ! !/S Enable subroutine tracing. 1727 ! 1728 ! 10. Source code : 1729 !/ ------------------------------------------------------------------- / 1730 !/ 1731 ! Page 49 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1732 USE CONSTANTS 1733 ! 1734 USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, MAPFS, DTCFL, & 1735 NK, NTH, DTH, XFR, MAPSTA, COUNTRI, & 1736 ECOS, ESIN, SIG, PFMOVE,IEN, COUNTOT, & 1737 NTRI, TRIGP, CCON , VNEIGH, & 1738 IE_CELL, POS_CELL, IOBP,IOBPD, XYB, TH, & 1739 ANGLE0, ANGLE, REFPARS, REFLC, REFLD 1740 1741 USE W3ODATMD, ONLY: TBPI0, TBPIN, FLBPI 1742 USE W3ADATMD, ONLY: CG, CX, CY, ATRNX, ATRNY, ITIME, CFLXYMAX 1743 USE W3IDATMD, ONLY: FLCUR 1744 ! USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, & 1745 ! ISBPI, BBPI0, BBPIN 1746 1747 IMPLICIT NONE 1748 !/ ------------------------------------------------------------------- / 1749 !/ Parameter list 1750 !/ 1751 !/ 1752 !/ ------------------------------------------------------------------- / 1753 !/ Local parameters 1754 !/ 1755 LOGICAL :: REDO_ANGLE 1756 INTEGER :: ITH, IK, ISEA, IXY, IBI, FOUND 1757 INTEGER :: IX, IY, I, J, IP, IP0, IP2, IPB, IE 1758 REAL :: CCOS, CSIN, CCURX, CCURY, THTEST 1759 REAL (KIND = 8) :: DIRMIN, DIRMAX, SHIFT, TEMPO, DIRCOAST, & 1760 DIRCOAST1, DIRCOAST2, SUMCOS1, SUMCOS2, DIRDIFF 1761 INTEGER :: SEANEIGHP(NX,15,2) 1762 REAL :: C(NX,2) 1763 REAL :: RD1, RD2 1764 REAL (KIND = 8) :: X1, X2, X3, Y1, Y2, Y3 1765 INTEGER :: SEACCON(NX), SEANEIGH(NX), SEA_CELL(COUNTOT) 1766 INTEGER :: COUNT_MAX 1767 INTEGER :: K, K2, I1, I2, I3 1768 INTEGER :: TRILAND(NTRI) 1769 REAL :: ANGLETOT(NX), ANGLETOTINV(NX) 1770 !/ ------------------------------------------------------------------- / 1771 ! 1772 ! 1. Preparations --------------------------------------------------- * 1773 ! 1.a Set constants 1774 ! 1775 1776 ! 1777 ! Counts the number of wet neighbor nodes 1778 ! 1779 SEANEIGH(1:NX)=0 1780 SEA_CELL(:)=0 1781 J = 0 1782 DO IX = 1, NX 1783 ! counts the wet connected nodes 1784 DO I = 1, 2*COUNTRI 1785 IF (VNEIGH(IX,I).NE.0) THEN 1786 IF (MAPSTA(1,VNEIGH(IX,I)).GT.0) SEANEIGH(IX)=SEANEIGH(IX)+1 1787 END IF 1788 END DO Page 50 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1789 END DO 1790 ! 1791 ! Counts the number of wet neighbor triangles 1792 ! 1793 SEACCON(1:NX)=0 1794 SEANEIGHP(:,:,:)=0 1795 J = 0 1796 DO IX = 1, NX 1797 DO I = 1, CCON(IX) ! Loop over all connected Elements 1798 J = J + 1 1799 IE = IE_CELL(J) ! Connected Element Number 1800 IF (MAPSTA(1,TRIGP(IE,1)).GT.0.AND. & 1801 MAPSTA(1,TRIGP(IE,2)).GT.0.AND. & 1802 MAPSTA(1,TRIGP(IE,3)).GT.0) THEN 1803 SEACCON(IX)=SEACCON(IX)+1 1804 SEA_CELL(J)=1 1805 END IF 1806 ! 1807 ! Used for reflection ... 1808 ! 1809 DO K2=1,3 1810 FOUND=0 1811 DO K=1,SEANEIGHP(IX,1,1) 1812 IF (SEANEIGHP(IX,K+1,1).EQ.TRIGP(IE,K2)) THEN 1813 SEANEIGHP(IX,K+1,2)=SEANEIGHP(IX,K+1,2)+1 1814 FOUND=1 1815 END IF 1816 END DO 1817 IF (FOUND.EQ.0) THEN 1818 SEANEIGHP(IX,1,1)=SEANEIGHP(IX,1,1)+1 1819 K=SEANEIGHP(IX,1,1) 1820 ! IF (K.GT.13) WRITE(6,*) 'SEANEIGHP :',IX,K,K2,TRIGP(IE,K2) 1821 SEANEIGHP(IX,K+1,1)=TRIGP(IE,K2) 1822 SEANEIGHP(IX,K+1,2)=1 1823 END IF 1824 END DO 1825 ! 1826 END DO 1827 END DO 1828 ! 1829 IOBP(:)=1 1830 IOBPD(:,:)=1 1831 ! 1832 ! Searches for boundary points 1833 ! 1834 DO IX = 1, NX 1835 IF (MAPSTA(1,IX).LE.0) THEN 1836 IOBP(IX)=0 1837 IOBPD(:,IX)=0 1838 END IF 1839 ! IF (SEACCON(IX) .LT. SEANEIGH(IX).AND.MAPSTA(1,IX).NE.2) THEN 1840 IF (SEACCON(IX) .LT. SEANEIGH(IX).AND.MAPSTA(1,IX).EQ.1) THEN 1841 IOBP(IX)=0 1842 ! WRITE(995,*) '@@@@ TRUE BOUNDARY:',IX,IOBP(IX),MAPSTA(1,IX),SEACCON(IX),SEANEIGH(IX),CCON(IX) 1843 !ELSE 1844 ! WRITE(995,*) ' NO BOUNDARY:',IX,IOBP(IX),MAPSTA(1,IX),SEACCON(IX),SEANEIGH(IX),CCON(IX) 1845 END IF Page 51 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1846 END DO 1847 ! 1848 ! Now looks for excluded angles 1849 ! 1850 J = 0 1851 DO IX = 1, NX 1852 DIRCOAST1=-999. 1853 DIRCOAST2=-999. 1854 IF (IOBP(IX).EQ.0) IOBPD(:,IX)=0 1855 DO I = 1, CCON(IX) ! Loop over all connected Elements 1856 J = J + 1 1857 IF ((IOBP(IX).EQ.0).AND.(SEA_CELL(J).EQ.1)) THEN 1858 IE = IE_CELL(J) ! Connected Element Number 1859 IP0 = POS_CELL(J) 1860 IP=MOD(IP0,3)+1 1861 IPB=MOD(IP0+1,3)+1 1862 ! 1863 ! We are now dealing with an excluded point that is a neighbor of a boundary point 1864 ! 1865 X1=DBLE(XYB(TRIGP(IE,IP0),1)) 1866 Y1=DBLE(XYB(TRIGP(IE,IP0),2)) 1867 X2=DBLE(XYB(TRIGP(IE,IP ),1)) 1868 Y2=DBLE(XYB(TRIGP(IE,IP ),2)) 1869 X3=DBLE(XYB(TRIGP(IE,IPB),1)) 1870 Y3=DBLE(XYB(TRIGP(IE,IPB),2)) 1871 1872 CALL line_angle( x2, y2, x1, y1, DIRMIN ) 1873 CALL line_angle( x3, y3, x1, y1, DIRMAX ) 1874 IF (DIRMAX.LT.DIRMIN) CALL d_swap(DIRMIN,DIRMAX) 1875 SHIFT=0 1876 IF (ABS(DIRMAX-DIRMIN).GT.PI) THEN 1877 TEMPO=DIRMAX 1878 DIRMAX=DIRMIN+DBLE(PI) 1879 DIRMIN=TEMPO-DBLE(PI) 1880 SHIFT=PI 1881 END IF 1882 DO ITH=1, NTH 1883 THTEST=MOD(TH(ITH)+SHIFT,DBLE(TPI)) 1884 IF ((THTEST.GE.DIRMIN) .AND. & 1885 (THTEST.LE.DIRMAX)) THEN 1886 IOBPD(ITH,IX) = 1 1887 !WRITE(995,*) 'IOBPD OUT:',IX,IE,ITH,IOBP(IX),TH(ITH)*RADE,DIRMIN*RADE,DIRMAX*RADE 1888 END IF 1889 END DO 1890 END IF 1891 END DO ! I = 1, CCON(IX) 1892 END DO 1893 1894 1895 ! 1896 1897 ! 1898 ! Recomputes the angles used in the gradients estimation 1899 ! 1900 !REDO_ANGLE = 1 1901 ! IF (REDO_ANGLE) THEN 1902 ! Page 52 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1903 ! MAP FOR LAND POINTS 1904 ! 1905 TRILAND(:) = 0 1906 K = 0 1907 DO IE = 1, NTRI 1908 I1 = TRIGP(IE,1) 1909 I2 = TRIGP(IE,2) 1910 I3 = TRIGP(IE,3) 1911 ! 1912 !! MAP FOR TRIANGLE STATUS: 1913 ! TRILAND=0 ->sea triangle 1914 ! TRILAND=1 , 2 -> contour 1915 ! TRILAND=3 -> land 1916 1917 1918 IF ((MAPSTA(1,I1).LE.0)) TRILAND(IE) = TRILAND(IE) + 1 1919 IF ((MAPSTA(1,I2).LE.0)) TRILAND(IE) = TRILAND(IE) + 1 1920 IF ((MAPSTA(1,I3).LE.0)) TRILAND(IE) = TRILAND(IE) + 1 1921 END DO 1922 ! 1923 ! Now calculate the angle of action of a vertex (see gradients in w3updtmd.ftn) 1924 ! If a triangle is connected to the contour, the angle of each vertex is not 1925 ! taken into account when interpolating gradients. 1926 ! 1927 ANGLETOT(:) = 0. ! TPI 1928 DO IE = 1, NTRI 1929 TRILAND(IE)=MIN(TRILAND(IE),1) 1930 I1 = TRIGP(IE,1) 1931 I2 = TRIGP(IE,2) 1932 I3 = TRIGP(IE,3) 1933 IF (TRILAND(IE) .EQ. 0) THEN 1934 ANGLETOT(I1) = ANGLETOT(I1) + ANGLE0(IE,1) 1935 ANGLETOT(I2) = ANGLETOT(I2) + ANGLE0(IE,2) 1936 ANGLETOT(I3) = ANGLETOT(I3) + ANGLE0(IE,3) 1937 END IF 1938 END DO 1939 1940 DO IP = 1, NX 1941 IF (ANGLETOT(IP) .NE. 0) THEN 1942 ANGLETOTINV(IP) = 1./ANGLETOT(IP) 1943 ELSE 1944 ANGLETOTINV(IP) = 0. 1945 END IF 1946 END DO 1947 ! 1948 DO IE = 1, NTRI 1949 I1 = TRIGP(IE,1) 1950 I2 = TRIGP(IE,2) 1951 I3 = TRIGP(IE,3) 1952 ! 1953 ! Angles for land triangles are set to zero 1954 ! 1955 ANGLE(IE,1) = ANGLE0(IE,1)*ANGLETOTINV(I1)*(1-TRILAND(IE)) 1956 ANGLE(IE,2) = ANGLE0(IE,2)*ANGLETOTINV(I2)*(1-TRILAND(IE)) 1957 ANGLE(IE,3) = ANGLE0(IE,3)*ANGLETOTINV(I3)*(1-TRILAND(IE)) 1958 !WRITE(998,*) 'IE, ANGLE:',IE,I1,I2,I3,ANGLE(IE,1:3),ANGLETOT(I1)*RADE,TRILAND(IE) 1959 Page 53 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1960 END DO 1961 1962 ! END IF 1963 1964 CALL DIFFERENCE 1965 1966 RETURN 1967 END SUBROUTINE SETUGIOBP ENTRY POINTS Name w3triamd_mp_setugiobp_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ABS Func 1876 scalar 1876 ANGLE Local 1739 R(4) 4 2 1 PTR 1739,1955,1956,1957 ANGLE0 Local 1739 R(4) 4 2 1 PTR 1739,1934,1935,1936,1955,1956,1957 ANGLETOT Local 1769 R(4) 4 1 0 1927,1934,1935,1936,1941,1942 ANGLETOTINV Local 1769 R(4) 4 1 0 1942,1944,1955,1956,1957 ATRNX Local 1742 R(4) 4 2 1 PTR 1742 ATRNY Local 1742 R(4) 4 2 1 PTR 1742 C Local 1762 R(4) 4 2 0 CCON Local 1737 I(4) 4 1 1 PTR 1737,1797,1855 CCOS Local 1758 R(4) 4 scalar CCURX Local 1758 R(4) 4 scalar CCURY Local 1758 R(4) 4 scalar CFLXYMAX Local 1742 R(4) 4 1 1 PTR 1742 CG Local 1742 R(4) 4 2 1 PTR 1742 CONSTANTS Module 1732 1732 COUNTOT Local 1736 I(4) 4 scalar PTR 1736,1765 COUNTRI Local 1735 I(4) 4 scalar PTR 1735,1784 COUNT_MAX Local 1766 I(4) 4 scalar CSIN Local 1758 R(4) 4 scalar CX Local 1742 R(4) 4 1 1 PTR 1742 CY Local 1742 R(4) 4 1 1 PTR 1742 DBLE Func 1865 scalar 1865,1866,1867,1868,1869,1870,1878 ,1879,1883 DIRCOAST Local 1759 R(8) 8 scalar DIRCOAST1 Local 1760 R(8) 8 scalar 1852 DIRCOAST2 Local 1760 R(8) 8 scalar 1853 DIRDIFF Local 1760 R(8) 8 scalar DIRMAX Local 1759 R(8) 8 scalar 1873,1874,1876,1877,1878,1885 DIRMIN Local 1759 R(8) 8 scalar 1872,1874,1876,1878,1879,1884 DTCFL Local 1734 R(4) 4 scalar PTR 1734 DTH Local 1735 R(4) 4 scalar PTR 1735 ECOS Local 1736 R(4) 4 1 1 PTR 1736 ESIN Local 1736 R(4) 4 1 1 PTR 1736 FLBPI Local 1741 L(4) 4 scalar PTR 1741 FLCUR Local 1743 L(4) 4 scalar PTR 1743 FOUND Local 1756 I(4) 4 scalar 1810,1814,1817 Page 54 Source Listing SETUGIOBP 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References I Local 1757 I(4) 4 scalar 1784,1785,1786,1797,1855 I1 Local 1767 I(4) 4 scalar 1908,1918,1930,1934,1949,1955 I2 Local 1767 I(4) 4 scalar 1909,1919,1931,1935,1950,1956 I3 Local 1767 I(4) 4 scalar 1910,1920,1932,1936,1951,1957 IBI Local 1756 I(4) 4 scalar IE Local 1757 I(4) 4 scalar 1799,1800,1801,1802,1812,1821,1858 ,1865,1866,1867,1868,1869,1870,190 7,1908,1909,1910,1918,1919,1920,19 28,1929,1930,1931,1932,1933,1934,1 935,1936,1948,1949,1950,1951,1955, 1956,1957 IEN Local 1736 R(4) 4 2 1 PTR 1736 IE_CELL Local 1738 I(4) 4 1 1 PTR 1738,1799,1858 IK Local 1756 I(4) 4 scalar IOBP Local 1738 I(4) 4 1 1 PTR 1738,1829,1836,1841,1854,1857 IOBPD Local 1738 I(4) 4 2 1 PTR 1738,1830,1837,1854,1886 IP Local 1757 I(4) 4 scalar 1860,1867,1868,1940,1941,1942,1944 IP0 Local 1757 I(4) 4 scalar 1859,1860,1861,1865,1866 IP2 Local 1757 I(4) 4 scalar IPB Local 1757 I(4) 4 scalar 1861,1869,1870 ISEA Local 1756 I(4) 4 scalar ITH Local 1756 I(4) 4 scalar 1882,1883,1886 ITIME Local 1742 I(4) 4 scalar PTR 1742 IX Local 1757 I(4) 4 scalar 1782,1785,1786,1796,1797,1803,1811 ,1812,1813,1818,1819,1821,1822,183 4,1835,1836,1837,1840,1841,1851,18 54,1855,1857,1886 IXY Local 1756 I(4) 4 scalar IY Local 1757 I(4) 4 scalar J Local 1757 I(4) 4 scalar 1781,1795,1798,1799,1804,1850,1856 ,1857,1858,1859 K Local 1767 I(4) 4 scalar 1811,1812,1813,1819,1821,1822,1906 K2 Local 1767 I(4) 4 scalar 1809,1812,1821 MAPFS Local 1734 I(4) 4 2 1 PTR 1734 MAPSF Local 1734 I(4) 4 2 1 PTR 1734 MAPSTA Local 1735 I(4) 4 2 1 PTR 1735,1786,1800,1801,1802,1835,1840 ,1918,1919,1920 MIN Func 1929 scalar 1929 MOD Func 1860 scalar 1860,1861,1883 NK Local 1735 I(4) 4 scalar PTR 1735 NSEA Local 1734 I(4) 4 scalar PTR 1734 NTH Local 1735 I(4) 4 scalar PTR 1735,1882 NTRI Local 1737 I(4) 4 scalar PTR 1737,1768,1907,1928,1948 NX Local 1734 I(4) 4 scalar PTR 1734,1761,1762,1765,1769,1779,1782 ,1793,1796,1834,1851,1940 NY Local 1734 I(4) 4 scalar PTR 1734 PFMOVE Local 1736 R(4) 4 scalar PTR 1736 PI Param 1876 R(4) 4 scalar 1876,1878,1879,1880 POS_CELL Local 1738 I(4) 4 1 1 PTR 1738,1859 RD1 Local 1763 R(4) 4 scalar RD2 Local 1763 R(4) 4 scalar REDO_ANGLE Local 1755 L(4) 4 scalar REFLC Local 1739 R(4) 4 2 1 PTR 1739 REFLD Local 1739 I(4) 4 2 1 PTR 1739 REFPARS Local 1739 R(4) 4 1 1 PTR 1739 Page 55 Source Listing SETUGIOBP 2014-09-16 16:48 Symbol Table w3triamd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References SEACCON Local 1765 I(4) 4 1 0 1793,1803,1840 SEANEIGH Local 1765 I(4) 4 1 0 1779,1786,1840 SEANEIGHP Local 1761 I(4) 4 3 0 1794,1811,1812,1813,1818,1819,1821 ,1822 SEA_CELL Local 1765 I(4) 4 1 0 1780,1804,1857 SETUGIOBP Subr 1677 SHIFT Local 1759 R(8) 8 scalar 1875,1880,1883 SIG Local 1736 R(4) 4 1 1 PTR 1736 SUMCOS1 Local 1760 R(8) 8 scalar SUMCOS2 Local 1760 R(8) 8 scalar TBPI0 Local 1741 I(4) 4 1 1 PTR 1741 TBPIN Local 1741 I(4) 4 1 1 PTR 1741 TEMPO Local 1759 R(8) 8 scalar 1877,1879 TH Local 1738 R(4) 4 1 1 PTR 1738,1883 THTEST Local 1758 R(4) 4 scalar 1883,1884,1885 TPI Param 1883 R(4) 4 scalar 1883 TRIGP Local 1737 I(4) 4 2 1 PTR 1737,1800,1801,1802,1812,1821,1865 ,1866,1867,1868,1869,1870,1908,190 9,1910,1930,1931,1932,1949,1950,19 51 TRILAND Local 1768 I(4) 4 1 0 1905,1918,1919,1920,1929,1933,1955 ,1956,1957 VNEIGH Local 1737 I(4) 4 2 1 PTR 1737,1785,1786 W3ADATMD Module 1742 1742 W3GDATMD Module 1734 1734 W3IDATMD Module 1743 1743 W3ODATMD Module 1741 1741 X1 Local 1764 R(8) 8 scalar 1865,1872,1873 X2 Local 1764 R(8) 8 scalar 1867,1872 X3 Local 1764 R(8) 8 scalar 1869,1873 XFR Local 1735 R(4) 4 scalar PTR 1735 XYB Local 1738 R(8) 8 2 1 PTR 1738,1865,1866,1867,1868,1869,1870 Y1 Local 1764 R(8) 8 scalar 1866,1872,1873 Y2 Local 1764 R(8) 8 scalar 1868,1872 Y3 Local 1764 R(8) 8 scalar 1870,1873 Page 56 Source Listing SETUGIOBP 2014-09-16 16:48 w3triamd.f90 1968 !/ ------------------------------------------------------------------- / 1969 1970 !C 1971 !C****************************************************************************** 1972 !C 1973 subroutine line_angle( x1, y1, x2, y2, angle ) 1974 implicit none 1975 real (kind = 8) x1, y1, x2, y2 1976 real (kind = 8) angle 1977 real (kind = 8) dx, dy 1978 1979 dx = x2 - x1 1980 dy = y2 - y1 1981 angle = atan2( dy, dx ) 1982 if ( angle < 0.0d0 ) angle = 8.0d0 * atan(1.0d0) + angle 1983 1984 return 1985 end subroutine ENTRY POINTS Name w3triamd_mp_line_angle_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ANGLE Dummy 1973 R(8) 8 scalar ARG,INOUT 1981,1982 ATAN Func 1982 scalar 1982 ATAN2 Func 1981 scalar 1981 DX Local 1977 R(8) 8 scalar 1979,1981 DY Local 1977 R(8) 8 scalar 1980,1981 LINE_ANGLE Subr 1973 1872,1873 X1 Dummy 1973 R(8) 8 scalar ARG,INOUT 1979 X2 Dummy 1973 R(8) 8 scalar ARG,INOUT 1979 Y1 Dummy 1973 R(8) 8 scalar ARG,INOUT 1980 Y2 Dummy 1973 R(8) 8 scalar ARG,INOUT 1980 Page 57 Source Listing LINE_ANGLE 2014-09-16 16:48 w3triamd.f90 1986 !C 1987 !C****************************************************************************** 1988 !C 1989 subroutine d_swap( a, b ) 1990 implicit none 1991 real (kind = 8) a, b 1992 real (kind = 8) dtmp 1993 1994 dtmp = a 1995 a = b 1996 b = dtmp 1997 1998 return 1999 end subroutine ENTRY POINTS Name w3triamd_mp_d_swap_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References A Dummy 1989 R(8) 8 scalar ARG,INOUT 1994,1995 B Dummy 1989 R(8) 8 scalar ARG,INOUT 1995,1996 DTMP Local 1992 R(8) 8 scalar 1994,1996 D_SWAP Subr 1989 1874 Page 58 Source Listing D_SWAP 2014-09-16 16:48 w3triamd.f90 2000 !/ 2001 END MODULE W3TRIAMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References BOUNDARY_NODE_INDEX Local 86 I(4) 4 1 1 ALC BOUND_EDGE_NUM Local 80 I(4) 4 scalar BOUND_NUM Local 81 I(4) 4 scalar DIM_NUM Local 77 I(4) 4 scalar EDGE Local 89 I(4) 4 2 1 ALC EDGE_ANGLE Local 95 R(8) 8 2 1 ALC EDGE_BOUNDARY Local 83 L(4) 4 1 1 ALC EDGE_INDEX Local 90 I(4) 4 2 1 ALC EDGE_NUMS Local 85 I(4) 4 1 1 ALC NODE_BOUNDARY Local 84 L(4) 4 1 1 ALC NODE_NUM Local 76 I(4) 4 scalar NODE_XY Local 94 R(8) 8 2 1 ALC TRIANGLE_NODE Local 88 I(4) 4 2 1 ALC TRIANGLE_NUM Local 79 I(4) 4 scalar TRIANGLE_ORDER Local 78 I(4) 4 scalar W3TRIAMD Module 1 Page 59 Source Listing D_SWAP 2014-09-16 16:48 Subprograms/Common Blocks w3triamd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References AREA_SI Subr 875 322 COORDMAX Subr 812 320 COUNT Subr 717 299 DIFFERENCE Subr 475 1964 D_SWAP Subr 1989 1874 IS_IN_UNGRID_INTERP Subr 1342 IS_IN_UNGRID_PLUS_COEFFICI ENT Subr 1176 LINE_ANGLE Subr 1973 1872,1873 NVECTRI Subr 590 319 READMSH Subr 99 SETUGIOBP Subr 1677 SPATIAL_GRID Subr 391 318 UG_GETOPENBOUNDARY Subr 326 UG_GRADIENTS Subr 1493 W3NESTUG Subr 1611 W3TRIAMD Module 1 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume cc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix Page 60 Source Listing D_SWAP 2014-09-16 16:48 w3triamd.f90 -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D _OPENMP=201107 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __SSE__ -D __MMX__ -D __AVX__ -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -openmp -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/usrx/local/intel/impi/4.0.3.008/intel64/include/, /usrx/local/intel/impi/4.0.3.008/intel64/include/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : w3triamd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100