- Timestamp:
- 2015-01-05T10:37:56+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r4314 r5007 67 67 68 68 ! Initialize 69 70 69 tmask_crs(:,:,:) = 0.0 71 70 vmask_crs(:,:,:) = 0.0 72 71 umask_crs(:,:,:) = 0.0 73 72 fmask_crs(:,:,:) = 0.0 74 75 76 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 77 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 78 je_2 = mje_crs(2) ; ij = je_2 79 ENDIF 80 ELSE 81 je_2 = mje_crs(2) ; ij = mjs_crs(2) 82 ENDIF 73 ! 83 74 DO jk = 1, jpkm1 84 DO ji = 2, nlei_crs 85 ijis = mis_crs(ji) ; ijie = mie_crs(ji) 86 ! 87 zmask = 0.0 88 zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) ) 89 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 90 91 zmask = 0.0 92 zmask = SUM( vmask(ijis:ijie,je_2 ,jk) ) 93 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 94 95 zmask = 0.0 96 zmask = SUM(umask(ijie,ij:je_2,jk)) 97 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 98 99 fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) 75 DO ji = 2, nlei_crs 76 ijie = mie_crs(ji) 77 ijis = mis_crs(ji) 78 79 IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN !!cc bande du sud style ORCA2 80 81 IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 82 83 jj = mje_crs(2) 84 85 zmask = 0.0 86 zmask = SUM( tmask(ijis:ijie,jj,jk) ) 87 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 88 89 zmask = 0.0 90 zmask = SUM( vmask(ijis:ijie,jj ,jk) ) 91 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 92 93 zmask = 0.0 94 zmask = umask(ijie ,jj,jk) 95 IF( zmask > 0.0 )umask_crs(ji,2,jk) = 1.0 96 97 fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 98 ENDIF 99 ELSE 100 101 jj = mje_crs(2) 102 ij = mjs_crs(2) 103 104 zmask = 0.0 105 zmask = SUM( tmask(ijis:ijie,ij:jj,jk) ) 106 IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 107 108 zmask = 0.0 109 zmask = SUM( vmask(ijis:ijie,jj ,jk) ) 110 IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 111 112 zmask = 0.0 113 zmask = SUM(umask(ijie,ij:jj,jk)) 114 IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 115 116 fmask_crs(ji,jj,jk) = fmask(ijie,2,jk) 117 118 ENDIF 119 120 DO jj = 3, nlej_crs 121 ijje = mje_crs(jj) 122 ijjs = mjs_crs(jj) 123 124 IF( ijje .GT. jpj )WRITE(narea+200,*)"BUG",jj,ijjs,ijje,SHAPE(tmask) ; call flush(narea+200) 125 zmask = 0.0 126 zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 127 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0 128 129 zmask = 0.0 130 zmask = SUM( vmask(ijis:ijie,ijje ,jk) ) 131 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0 132 133 zmask = 0.0 134 zmask = SUM( umask(ijie ,ijjs:ijje,jk) ) 135 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0 136 137 fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk) 138 139 ENDDO 100 140 ENDDO 101 141 ENDDO 102 !103 DO jk = 1, jpkm1104 DO ji = 2, nlei_crs105 ijis = mis_crs(ji) ; ijie = mie_crs(ji)106 DO jj = 3, nlej_crs107 ijjs = mjs_crs(jj) ; ijje = mje_crs(jj)108 109 zmask = 0.0110 zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )111 IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0112 113 zmask = 0.0114 zmask = SUM( vmask(ijis:ijie,ijje ,jk) )115 IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0116 117 zmask = 0.0118 zmask = SUM( umask(ijie ,ijjs:ijje,jk) )119 IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0120 121 fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)122 ENDDO123 ENDDO124 ENDDO125 126 142 ! 127 143 CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) … … 686 702 CASE( 'V' ) 687 703 688 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 689 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 690 ijje = mje_crs(2) 691 ENDIF 692 ELSE 693 ijje = mjs_crs(2) 694 ENDIF 695 ! 696 DO jk = 1, jpk 704 DO jk = 1, jpk 697 705 DO ji = nistr, niend, nn_factx 698 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 699 zflcrs = p_fld(ji ,ijje,jk) * zsurfmsk(ji ,ijje,jk) & 700 & + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 701 & + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 702 ! 703 p_fld_crs(ii,2,jk) = zflcrs 704 ENDDO 705 ENDDO 706 ! 707 DO jk = 1, jpk 708 DO jj = njstr, njend, nn_facty 709 DO ji = nistr, niend, nn_factx 710 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 706 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 707 IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN !!cc bande du sud style ORCA2 708 IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 709 jj = mje_crs(2) 710 zflcrs = p_fld(ji ,jj ,jk) * zsurfmsk(ji ,jj ,jk) & 711 & + p_fld(ji+1,jj ,jk) * zsurfmsk(ji+1,jj ,jk) & 712 & + p_fld(ji+2,jj ,jk) * zsurfmsk(ji+2,jj ,jk) 713 714 zsfcrs = zsurfmsk(ji ,jj ,jk) & 715 & + zsurfmsk(ji+1,jj ,jk) & 716 & + zsurfmsk(ji+2,jj ,jk) 717 718 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 719 ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 720 ENDIF 721 ENDIF 722 ELSE 723 ijje = mje_crs(2) 724 zflcrs = p_fld(ji ,ijje,jk) * zsurfmsk(ji ,ijje,jk) & 725 & + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 726 & + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 727 ! 728 zsfcrs = zsurfmsk(ji ,ijje,jk) & 729 & + zsurfmsk(ji+1,ijje,jk) & 730 & + zsurfmsk(ji+2,ijje,jk) 731 732 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,2,jk) = zflcrs 733 ELSE ; p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 734 ENDIF 735 736 ENDIF 737 738 DO jj = njstr, njend, nn_facty 739 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 711 740 ij = ( jj - njstr ) * rfacty_r + 3 712 741 ijje = mje_crs(ij) 742 ijie = mie_crs(ii) 743 ! 713 744 zflcrs = p_fld(ji ,ijje,jk) * zsurfmsk(ji ,ijje,jk) & 714 745 & + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 715 746 & + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk) 716 ! 717 p_fld_crs(ii,ij,jk) = zflcrs 718 ! 719 ENDDO 747 ! 748 zsfcrs = zsurfmsk(ji ,ijje,jk) & 749 & + zsurfmsk(ji+1,ijje,jk) & 750 & + zsurfmsk(ji+2,ijje,jk) 751 752 IF( zsfcrs == 0 ) THEN ; p_fld_crs(ii,ij,jk) = zflcrs 753 ELSE ; p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 754 ENDIF 755 ! 756 ENDDO 720 757 ENDDO 721 ENDDO 722 758 ENDDO 759 723 760 CASE( 'U' ) 724 761 … … 854 891 CASE( 'V' ) 855 892 856 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2857 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN858 ijje = mje_crs(2)859 ENDIF860 ELSE861 ijje = mjs_crs(2)862 ENDIF863 864 DO jk = 1, jpk865 DO ji = nistr, niend, nn_factx866 ii = ( ji - mis_crs(2) ) * rfactx_r + 2867 zflcrs = &868 & MAX( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , &869 & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , &870 & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )871 !872 p_fld_crs(ii,2,jk) = zflcrs873 ENDDO874 ENDDO875 !876 DO jk = 1, jpk877 DO jj = njstr, njend, nn_facty878 DO ji = nistr, niend, nn_factx879 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid880 ij = ( jj - njstr ) * rfacty_r + 3881 ijje = mje_crs(ij)882 !883 zflcrs = &884 & MAX( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , &885 & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , &886 & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf )887 !888 p_fld_crs(ii,ij,jk) = zflcrs889 !890 ENDDO891 ENDDO892 ENDDO893 893 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 894 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 895 ! ijje = mje_crs(2) 896 ! ENDIF 897 ! ELSE 898 ! ijje = mjs_crs(2) 899 ! ENDIF 900 ! 901 ! DO jk = 1, jpk 902 ! DO ji = nistr, niend, nn_factx 903 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 904 ! zflcrs = & 905 ! & MAX( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 906 ! & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 907 ! & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 908 ! ! 909 ! p_fld_crs(ii,2,jk) = zflcrs 910 ! ENDDO 911 ! ENDDO 912 ! ! 913 ! DO jk = 1, jpk 914 ! DO jj = njstr, njend, nn_facty 915 ! DO ji = nistr, niend, nn_factx 916 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 917 ! ij = ( jj - njstr ) * rfacty_r + 3 918 ! ijje = mje_crs(ij) 919 ! ! 920 ! zflcrs = & 921 ! & MAX( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 922 ! & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 923 ! & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 924 ! ! 925 ! p_fld_crs(ii,ij,jk) = zflcrs 926 ! ! 927 ! ENDDO 928 ! ENDDO 929 ! ENDDO 930 CALL ctl_stop('MAX operator and V case not available') 894 931 895 932 CASE( 'U' ) 896 933 897 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 898 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 899 je_2 = mje_crs(2) 900 DO jk = 1, jpk 901 DO ji = nistr, niend, nn_factx 902 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 903 ijie = mie_crs(ii) 904 zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 905 ! 906 p_fld_crs(ii,2,jk) = zflcrs 907 ENDDO 908 ENDDO 909 ENDIF 910 ELSE 911 je_2 = mjs_crs(2) 912 DO jk = 1, jpk 913 DO ji = nistr, niend, nn_factx 914 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 915 ijie = mie_crs(ii) 916 zflcrs = & 917 & MAX( p_fld(ijie,je_2 ,jk) * p_mask(ijie,je_2 ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 918 & p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 919 & p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ) 920 ! 921 p_fld_crs(ii,2,jk) = zflcrs 922 ENDDO 923 ENDDO 924 ENDIF 925 ! 926 DO jk = 1, jpk 927 DO jj = njstr, njend, nn_facty 928 DO ji = nistr, niend, nn_factx 929 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 930 ij = ( jj - njstr ) * rfacty_r + 3 931 ijie = mie_crs(ii) 932 zflcrs = & 933 & MAX( p_fld(ijie,jj ,jk) * p_mask(ijie,jj ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 934 & p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 935 & p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ) 936 ! 937 p_fld_crs(ii,ij,jk) = zflcrs 938 ! 939 ENDDO 940 ENDDO 941 ENDDO 934 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 935 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 936 ! je_2 = mje_crs(2) 937 ! DO jk = 1, jpk 938 ! DO ji = nistr, niend, nn_factx 939 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 940 ! ijie = mie_crs(ii) 941 ! zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 942 ! ! 943 ! p_fld_crs(ii,2,jk) = zflcrs 944 ! ENDDO 945 ! ENDDO 946 ! ENDIF 947 ! ELSE 948 ! je_2 = mjs_crs(2) 949 ! DO jk = 1, jpk 950 ! DO ji = nistr, niend, nn_factx 951 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 952 ! ijie = mie_crs(ii) 953 ! zflcrs = & 954 ! & MAX( p_fld(ijie,je_2 ,jk) * p_mask(ijie,je_2 ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 955 ! & p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 956 ! & p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ) 957 ! ! 958 ! p_fld_crs(ii,2,jk) = zflcrs 959 ! ENDDO 960 ! ENDDO 961 ! ENDIF 962 ! ! 963 ! DO jk = 1, jpk 964 ! DO jj = njstr, njend, nn_facty 965 ! DO ji = nistr, niend, nn_factx 966 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 967 ! ij = ( jj - njstr ) * rfacty_r + 3 968 ! ijie = mie_crs(ii) 969 ! zflcrs = & 970 ! & MAX( p_fld(ijie,jj ,jk) * p_mask(ijie,jj ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 971 ! & p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 972 ! & p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf ) 973 ! ! 974 ! p_fld_crs(ii,ij,jk) = zflcrs 975 ! ! 976 ! ENDDO 977 ! ENDDO 978 ! ENDDO 979 CALL ctl_stop('MAX operator and U case not available') 942 980 943 981 END SELECT … … 1025 1063 CASE( 'V' ) 1026 1064 1027 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1028 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1029 ijje = mje_crs(2) 1030 ENDIF 1031 ELSE 1032 ijje = mjs_crs(2) 1033 ENDIF 1034 1035 DO jk = 1, jpk 1036 DO ji = nistr, niend, nn_factx 1037 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1038 zflcrs = & 1039 & MIN( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1040 & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1041 & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 1042 ! 1043 p_fld_crs(ii,2,jk) = zflcrs 1044 ENDDO 1045 ENDDO 1046 ! 1047 DO jk = 1, jpk 1048 DO jj = njstr, njend, nn_facty 1049 DO ji = nistr, niend, nn_factx 1050 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 1051 ij = ( jj - njstr ) * rfacty_r + 3 1052 ijje = mje_crs(ij) 1053 zflcrs = & 1054 & MIN( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1055 & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1056 & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 1057 ! 1058 p_fld_crs(ii,ij,jk) = zflcrs 1059 ! 1060 ENDDO 1061 ENDDO 1062 ENDDO 1065 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1066 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1067 ! ijje = mje_crs(2) 1068 ! ENDIF 1069 ! ELSE 1070 ! ijje = mjs_crs(2) 1071 ! ENDIF 1072 ! 1073 ! DO jk = 1, jpk 1074 ! DO ji = nistr, niend, nn_factx 1075 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1076 ! zflcrs = & 1077 ! & MIN( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1078 ! & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1079 ! & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 1080 ! ! 1081 ! p_fld_crs(ii,2,jk) = zflcrs 1082 ! ENDDO 1083 ! ENDDO 1084 ! ! 1085 ! DO jk = 1, jpk 1086 ! DO jj = njstr, njend, nn_facty 1087 ! DO ji = nistr, niend, nn_factx 1088 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 ! cordinate in parent grid 1089 ! ij = ( jj - njstr ) * rfacty_r + 3 1090 ! ijje = mje_crs(ij) 1091 ! zflcrs = & 1092 ! & MIN( p_fld(ji ,ijje,jk) * p_mask(ji ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1093 ! & p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf , & 1094 ! & p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 1095 ! ! 1096 ! p_fld_crs(ii,ij,jk) = zflcrs 1097 ! ! 1098 ! ENDDO 1099 ! ENDDO 1100 ! ENDDO 1101 CALL ctl_stop('MIN operator and V case not available') 1063 1102 1064 1103 1065 1104 CASE( 'U' ) 1066 1105 1067 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1068 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1069 je_2 = mje_crs(2) 1070 DO jk = 1, jpk 1071 DO ji = nistr, niend, nn_factx 1072 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1073 ijie = mie_crs(ii) 1074 zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 1075 ! 1076 p_fld_crs(ii,2,jk) = zflcrs 1077 ENDDO 1078 ENDDO 1079 ENDIF 1080 ELSE 1081 je_2 = mjs_crs(2) 1082 DO jk = 1, jpk 1083 DO ji = nistr, niend, nn_factx 1084 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1085 ijie = mie_crs(ii) 1086 zflcrs = & 1087 & MIN( p_fld(ijie,je_2 ,jk) * p_mask(ijie,je_2 ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 1088 & p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 1089 & p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ) 1090 ! 1091 p_fld_crs(ii,2,jk) = zflcrs 1092 ENDDO 1093 ENDDO 1094 ENDIF 1095 ! 1096 DO jk = 1, jpk 1097 DO jj = njstr, njend, nn_facty 1098 DO ji = nistr, niend, nn_factx 1099 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1100 ij = ( jj - njstr ) * rfacty_r + 3 1101 ijie = mie_crs(ii) 1102 zflcrs = & 1103 & MIN( p_fld(ijie,jj ,jk) * p_mask(ijie,jj ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 1104 & p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 1105 & p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ) 1106 ! 1107 p_fld_crs(ii,ij,jk) = zflcrs 1108 ! 1109 ENDDO 1110 ENDDO 1111 ENDDO 1106 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1107 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1108 ! je_2 = mje_crs(2) 1109 ! DO jk = 1, jpk 1110 ! DO ji = nistr, niend, nn_factx 1111 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1112 ! ijie = mie_crs(ii) 1113 ! zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf 1114 ! ! 1115 ! p_fld_crs(ii,2,jk) = zflcrs 1116 ! ENDDO 1117 ! ENDDO 1118 ! ENDIF 1119 ! ELSE 1120 ! je_2 = mjs_crs(2) 1121 ! DO jk = 1, jpk 1122 ! DO ji = nistr, niend, nn_factx 1123 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1124 ! ijie = mie_crs(ii) 1125 ! zflcrs = & 1126 ! & MIN( p_fld(ijie,je_2 ,jk) * p_mask(ijie,je_2 ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 1127 ! & p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf , & 1128 ! & p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ) 1129 ! ! 1130 ! p_fld_crs(ii,2,jk) = zflcrs 1131 ! ENDDO 1132 ! ENDDO 1133 ! ENDIF 1134 ! ! 1135 ! DO jk = 1, jpk 1136 ! DO jj = njstr, njend, nn_facty 1137 ! DO ji = nistr, niend, nn_factx 1138 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1139 ! ij = ( jj - njstr ) * rfacty_r + 3 1140 ! ijie = mie_crs(ii) 1141 ! zflcrs = & 1142 ! & MIN( p_fld(ijie,jj ,jk) * p_mask(ijie,jj ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 1143 ! & p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 1144 ! & p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ) 1145 ! ! 1146 ! p_fld_crs(ii,ij,jk) = zflcrs 1147 ! ! 1148 ! ENDDO 1149 ! ENDDO 1150 ! ENDDO 1151 CALL ctl_stop('MIN operator and U case not available') 1112 1152 1113 1153 END SELECT … … 1280 1320 ENDDO 1281 1321 ENDIF 1282 1322 ! 1283 1323 DO jj = njstr, njend, nn_facty 1284 1324 DO ji = nistr, niend, nn_factx … … 1294 1334 & + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2) & 1295 1335 & + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2) 1296 1336 ! 1297 1337 p_fld_crs(ii,ij) = zflcrs 1298 1338 ! … … 1301 1341 1302 1342 CASE( 'V' ) 1303 1304 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1305 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1306 ijje = mje_crs(2) 1343 DO ji = nistr, niend, nn_factx 1344 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1345 IF( nldj_crs == 1 .AND. (( mje_crs(2) - mjs_crs(2) ) < 2) )THEN !!cc bande du sud style ORCA2 1346 IF( mje_crs(2) - mjs_crs(2) == 1 )THEN 1347 jj = mje_crs(2) 1348 zflcrs = p_fld(ji ,jj ) * zsurfmsk(ji ,jj ) & 1349 & + p_fld(ji+1,jj ) * zsurfmsk(ji+1,jj ) & 1350 & + p_fld(ji+2,jj ) * zsurfmsk(ji+2,jj ) 1351 p_fld_crs(ii,2) = zflcrs 1352 ENDIF 1353 ELSE 1354 ijje = mje_crs(2) 1355 zflcrs = p_fld(ji ,ijje) * zsurfmsk(ji ,ijje) & 1356 & + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 1357 & + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 1358 ! 1359 p_fld_crs(ii,2) = zflcrs 1307 1360 ENDIF 1308 ELSE 1309 ijje = mjs_crs(2) 1310 ENDIF 1311 1312 DO ji = nistr, niend, nn_factx 1313 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1314 zflcrs = p_fld(ji ,ijje) * zsurfmsk(ji ,ijje) & 1315 & + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 1316 & + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 1317 ! 1318 p_fld_crs(ii,2) = zflcrs 1319 ENDDO 1320 1321 DO jj = njstr, njend, nn_facty 1322 DO ji = nistr, niend, nn_factx 1323 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1324 ij = ( jj - njstr ) * rfacty_r + 3 1325 ijje = mje_crs(ij) 1326 zflcrs = p_fld(ji ,ijje) * zsurfmsk(ji ,ijje) & 1327 & + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 1328 & + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 1329 ! 1330 p_fld_crs(ii,ij) = zflcrs 1331 ! 1332 ENDDO 1333 ENDDO 1361 1362 DO jj = njstr, njend, nn_facty 1363 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1364 ij = ( jj - njstr ) * rfacty_r + 3 1365 ijje = mje_crs(ij) 1366 ijie = mie_crs(ii) 1367 ! 1368 zflcrs = p_fld(ji ,ijje) * zsurfmsk(ji ,ijje) & 1369 & + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 1370 & + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje) 1371 ! 1372 p_fld_crs(ii,ij) = zflcrs 1373 ! 1374 ENDDO 1375 ENDDO 1334 1376 1335 1377 CASE( 'U' ) … … 1386 1428 CASE( 'T', 'W' ) 1387 1429 1388 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA21389 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN1390 je_2 = mje_crs(2)1391 DO ji = nistr, niend, nn_factx1392 ii = ( ji - mis_crs(2) ) * rfactx_r + 21430 DO ji = nistr, niend, nn_factx 1431 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1432 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1433 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1434 je_2 = mje_crs(2) 1393 1435 zflcrs = & 1394 1436 & MAX( p_fld(ji ,je_2) * p_mask(ji ,je_2,1) - ( 1.- p_mask(ji ,je_2,1) ) * r_inf , & 1395 &p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf , &1396 &p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf )1437 & p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf , & 1438 & p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf ) 1397 1439 ! 1398 1440 p_fld_crs(ii,2) = zflcrs 1399 ENDDO 1441 ENDIF 1442 ELSE 1443 je_2 = mjs_crs(2) 1444 zflcrs = & 1445 & MAX( p_fld(ji ,je_2 ) * p_mask(ji ,je_2 ,1) - ( 1.- p_mask(ji ,je_2 ,1) ) * r_inf , & 1446 & p_fld(ji+1,je_2 ) * p_mask(ji+1,je_2 ,1) - ( 1.- p_mask(ji+1,je_2 ,1) ) * r_inf , & 1447 & p_fld(ji+2,je_2 ) * p_mask(ji+2,je_2 ,1) - ( 1.- p_mask(ji+2,je_2 ,1) ) * r_inf , & 1448 & p_fld(ji ,je_2+1) * p_mask(ji ,je_2+1,1) - ( 1.- p_mask(ji ,je_2+1,1) ) * r_inf , & 1449 & p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf , & 1450 & p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf , & 1451 & p_fld(ji ,je_2+2) * p_mask(ji ,je_2+2,1) - ( 1.- p_mask(ji ,je_2+2,1) ) * r_inf , & 1452 & p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf , & 1453 & p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf ) 1454 ! 1455 p_fld_crs(ii,2) = zflcrs 1400 1456 ENDIF 1401 ELSE 1402 je_2 = mjs_crs(2) 1403 zflcrs = & 1404 & MAX( p_fld(ji ,je_2 ) * p_mask(ji ,je_2 ,1) - ( 1.- p_mask(ji ,je_2 ,1) ) * r_inf , & 1405 & p_fld(ji+1,je_2 ) * p_mask(ji+1,je_2 ,1) - ( 1.- p_mask(ji+1,je_2 ,1) ) * r_inf , & 1406 & p_fld(ji+2,je_2 ) * p_mask(ji+2,je_2 ,1) - ( 1.- p_mask(ji+2,je_2 ,1) ) * r_inf , & 1407 & p_fld(ji ,je_2+1) * p_mask(ji ,je_2+1,1) - ( 1.- p_mask(ji ,je_2+1,1) ) * r_inf , & 1408 & p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf , & 1409 & p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf , & 1410 & p_fld(ji ,je_2+2) * p_mask(ji ,je_2+2,1) - ( 1.- p_mask(ji ,je_2+2,1) ) * r_inf , & 1411 & p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf , & 1412 & p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf ) 1413 ! 1414 p_fld_crs(ii,2) = zflcrs 1415 ENDIF 1416 1417 DO jj = njstr, njend, nn_facty 1418 DO ji = nistr, niend, nn_factx 1457 1458 DO jj = njstr, njend, nn_facty 1419 1459 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1420 1460 ij = ( jj - njstr ) * rfacty_r + 3 … … 1437 1477 CASE( 'V' ) 1438 1478 1439 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1440 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1441 ijje = mje_crs(2) 1442 ENDIF 1443 ELSE 1444 ijje = mjs_crs(2) 1445 ENDIF 1446 1447 DO ji = nistr, niend, nn_factx 1448 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1449 zflcrs = MAX( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1450 & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1451 & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1452 ! 1453 p_fld_crs(ii,2) = zflcrs 1454 ENDDO 1455 DO jj = njstr, njend, nn_facty 1456 DO ji = nistr, niend, nn_factx 1457 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1458 ij = ( jj - njstr ) * rfacty_r + 3 1459 ijje = mje_crs(ij) 1460 ! 1461 zflcrs = MAX( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1462 & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1463 & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1464 ! 1465 p_fld_crs(ii,ij) = zflcrs 1466 ! 1467 ENDDO 1468 ENDDO 1479 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1480 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1481 ! ijje = mje_crs(2) 1482 ! ENDIF 1483 ! ELSE 1484 ! ijje = mjs_crs(2) 1485 ! ENDIF 1486 ! 1487 ! DO ji = nistr, niend, nn_factx 1488 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1489 ! zflcrs = MAX( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1490 ! & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1491 ! & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1492 ! ! 1493 ! p_fld_crs(ii,2) = zflcrs 1494 ! ENDDO 1495 ! DO jj = njstr, njend, nn_facty 1496 ! DO ji = nistr, niend, nn_factx 1497 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1498 ! ij = ( jj - njstr ) * rfacty_r + 3 1499 ! ijje = mje_crs(ij) 1500 ! ! 1501 ! zflcrs = MAX( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1502 ! & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1503 ! & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1504 ! ! 1505 ! p_fld_crs(ii,ij) = zflcrs 1506 ! ! 1507 ! ENDDO 1508 ! ENDDO 1509 CALL ctl_stop('MAX operator and V case not available') 1469 1510 1470 1511 CASE( 'U' ) 1471 1512 1472 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1473 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1474 je_2 = mje_crs(2) 1475 DO ji = nistr, niend, nn_factx 1476 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1477 ijie = mie_crs(ii) 1478 zflcrs = p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf 1479 p_fld_crs(ii,2) = zflcrs 1480 ENDDO 1481 ENDIF 1482 ELSE 1483 je_2 = mjs_crs(2) 1484 DO ji = nistr, niend, nn_factx 1485 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1486 ijie = mie_crs(ii) 1487 zflcrs = & 1488 & MAX( p_fld(ijie,je_2 ) * p_mask(ijie,je_2 ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1489 & p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1490 & p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ) 1491 p_fld_crs(ii,2) = zflcrs 1492 ENDDO 1493 ENDIF 1494 DO jj = njstr, njend, nn_facty 1495 DO ji = nistr, niend, nn_factx 1496 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1497 ij = ( jj - njstr ) * rfacty_r + 3 1498 ijie = mie_crs(ii) 1499 zflcrs = & 1500 & MAX( p_fld(ijie,jj ) * p_mask(ijie,jj ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1501 & p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1502 & p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ) 1503 p_fld_crs(ii,ij) = zflcrs 1504 ! 1505 ENDDO 1506 ENDDO 1513 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1514 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1515 ! je_2 = mje_crs(2) 1516 ! DO ji = nistr, niend, nn_factx 1517 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1518 ! ijie = mie_crs(ii) 1519 ! zflcrs = p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf 1520 ! p_fld_crs(ii,2) = zflcrs 1521 ! ENDDO 1522 ! ENDIF 1523 ! ELSE 1524 ! je_2 = mjs_crs(2) 1525 ! DO ji = nistr, niend, nn_factx 1526 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1527 ! ijie = mie_crs(ii) 1528 ! zflcrs = & 1529 ! & MAX( p_fld(ijie,je_2 ) * p_mask(ijie,je_2 ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1530 ! & p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1531 ! & p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ) 1532 ! p_fld_crs(ii,2) = zflcrs 1533 ! ENDDO 1534 ! ENDIF 1535 ! DO jj = njstr, njend, nn_facty 1536 ! DO ji = nistr, niend, nn_factx 1537 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1538 ! ij = ( jj - njstr ) * rfacty_r + 3 1539 ! ijie = mie_crs(ii) 1540 ! zflcrs = & 1541 ! & MAX( p_fld(ijie,jj ) * p_mask(ijie,jj ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1542 ! & p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1543 ! & p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ) 1544 ! p_fld_crs(ii,ij) = zflcrs 1545 ! ! 1546 ! ENDDO 1547 ! ENDDO 1548 CALL ctl_stop('MAX operator and U case not available') 1507 1549 1508 1550 END SELECT … … 1565 1607 CASE( 'V' ) 1566 1608 1567 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1568 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1569 ijje = mje_crs(2) 1570 ENDIF 1571 ELSE 1572 ijje = mjs_crs(2) 1573 ENDIF 1574 1575 DO ji = nistr, niend, nn_factx 1576 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1577 zflcrs = MIN( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1578 & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1579 & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1580 ! 1581 p_fld_crs(ii,2) = zflcrs 1582 ENDDO 1583 DO jj = njstr, njend, nn_facty 1584 DO ji = nistr, niend, nn_factx 1585 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1586 ij = ( jj - njstr ) * rfacty_r + 3 1587 ijje = mje_crs(ij) 1588 ! 1589 zflcrs = MIN( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1590 & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1591 & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1592 ! 1593 p_fld_crs(ii,ij) = zflcrs 1594 ! 1595 ENDDO 1596 ENDDO 1609 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1610 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1611 ! ijje = mje_crs(2) 1612 ! ENDIF 1613 ! ELSE 1614 ! ijje = mjs_crs(2) 1615 ! ENDIF 1616 ! 1617 ! DO ji = nistr, niend, nn_factx 1618 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1619 ! zflcrs = MIN( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1620 ! & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1621 ! & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1622 ! ! 1623 ! p_fld_crs(ii,2) = zflcrs 1624 ! ENDDO 1625 ! DO jj = njstr, njend, nn_facty 1626 ! DO ji = nistr, niend, nn_factx 1627 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1628 ! ij = ( jj - njstr ) * rfacty_r + 3 1629 ! ijje = mje_crs(ij) 1630 ! ! 1631 ! zflcrs = MIN( p_fld(ji ,ijje) * p_mask(ji ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1632 ! & p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf , & 1633 ! & p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 1634 ! ! 1635 ! p_fld_crs(ii,ij) = zflcrs 1636 ! ! 1637 ! ENDDO 1638 ! ENDDO 1639 CALL ctl_stop('MIN operator and V case not available') 1597 1640 1598 1641 CASE( 'U' ) 1599 1642 1600 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1601 IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1602 je_2 = mje_crs(2) 1603 DO ji = nistr, niend, nn_factx 1604 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1605 ijie = mie_crs(ii) 1606 zflcrs = p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf 1607 1608 p_fld_crs(ii,2) = zflcrs 1609 ENDDO 1610 ENDIF 1611 ELSE 1612 je_2 = mjs_crs(2) 1613 DO ji = nistr, niend, nn_factx 1614 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1615 ijie = mie_crs(ii) 1616 zflcrs = & 1617 & MIN( p_fld(ijie,je_2 ) * p_mask(ijie,je_2 ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1618 & p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1619 & p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ) 1620 p_fld_crs(ii,2) = zflcrs 1621 ENDDO 1622 ENDIF 1623 DO jj = njstr, njend, nn_facty 1624 DO ji = nistr, niend, nn_factx 1625 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1626 ij = ( jj - njstr ) * rfacty_r + 3 1627 ijie = mie_crs(ii) 1628 zflcrs = & 1629 & MIN( p_fld(ijie,jj ) * p_mask(ijie,jj ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1630 & p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1631 & p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ) 1632 p_fld_crs(ii,ij) = zflcrs 1633 ! 1634 ENDDO 1635 ENDDO 1643 ! IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN !!cc bande du sud style ORCA2 1644 ! IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 1645 ! je_2 = mje_crs(2) 1646 ! DO ji = nistr, niend, nn_factx 1647 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1648 ! ijie = mie_crs(ii) 1649 ! zflcrs = p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf 1650 ! 1651 ! p_fld_crs(ii,2) = zflcrs 1652 ! ENDDO 1653 ! ENDIF 1654 ! ELSE 1655 ! je_2 = mjs_crs(2) 1656 ! DO ji = nistr, niend, nn_factx 1657 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1658 ! ijie = mie_crs(ii) 1659 ! zflcrs = & 1660 ! & MIN( p_fld(ijie,je_2 ) * p_mask(ijie,je_2 ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1661 ! & p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf , & 1662 ! & p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ) 1663 ! p_fld_crs(ii,2) = zflcrs 1664 ! ENDDO 1665 ! ENDIF 1666 ! DO jj = njstr, njend, nn_facty 1667 ! DO ji = nistr, niend, nn_factx 1668 ! ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1669 ! ij = ( jj - njstr ) * rfacty_r + 3 1670 ! ijie = mie_crs(ii) 1671 ! zflcrs = & 1672 ! & MIN( p_fld(ijie,jj ) * p_mask(ijie,jj ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1673 ! & p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf , & 1674 ! & p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ) 1675 ! p_fld_crs(ii,ij) = zflcrs 1676 ! ! 1677 ! ENDDO 1678 ! ENDDO 1679 CALL ctl_stop('MIN operator and U case not available') 1636 1680 1637 1681 END SELECT … … 1750 1794 & + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 1751 1795 1752 p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1796 !cbr 1797 !p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1798 IF( p_sfc_crs(ii,ij,jk) == 0.d0 )WRITE(narea+200,*)"crs_dom_e30 ",ii,ij,jk,p_sfc_crs(ii,ij,jk) ; call flush(narea+200) 1799 IF( p_sfc_crs(ii,ij,jk) .NE. 0.d0 )THEN ; p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 1800 ELSE ; p_e3_crs(ii,ij,jk) =0.d0 1801 ENDIF 1753 1802 ! 1754 1803 ze3crs = MAX( p_e3(ji ,jj ,jk) * zmask(ji ,jj ,jk), & … … 1867 1916 ii = ( ji - mis_crs(2) ) * rfactx_r + 2 1868 1917 ij = ( jj - njstr ) * rfacty_r + 3 1918 IF( jk==1 .AND. ii==2 .AND. ij==18 )THEN 1919 WRITE(narea+200,*)"crs_dom_sfc ",zsurf(ji,jj ,jk) , zsurf(ji+1,jj ,jk) , zsurf(ji+2,jj ,jk) & 1920 & , zsurf(ji,jj+1,jk) , zsurf(ji+1,jj+1,jk) , zsurf(ji+2,jj+1,jk) & 1921 & , zsurf(ji,jj+2,jk) , zsurf(ji+1,jj+2,jk) , zsurf(ji+2,jj+2,jk) 1922 call flush(narea+200) 1923 ENDIF 1869 1924 ! 1870 1925 p_surf_crs (ii,ij,jk) = zsurf(ji,jj ,jk) + zsurf(ji+1,jj ,jk) + zsurf(ji+2,jj ,jk) & 1871 1926 & + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 1872 1927 & + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk) 1873 1928 IF( jk==1 .AND. ii==2 .AND. ij==18 )WRITE(narea+200,*)"crs_dom_sfc ",p_surf_crs (ii,ij,jk) ; call flush(narea+200) 1874 1929 p_surf_crs_msk(ii,ij,jk) = zsurfmsk(ji,jj ,jk) + zsurfmsk(ji+1,jj ,jk) + zsurfmsk(ji+2,jj ,jk) & 1875 1930 & + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk) & … … 1878 1933 ENDDO 1879 1934 ENDDO 1880 1935 WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs (2,18,1) 1881 1936 CALL crs_lbc_lnk( p_surf_crs , cd_type, 1.0, pval=1.0 ) 1882 1937 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1938 WRITE(narea+200,*)"crs_dom_sfc end ", p_surf_crs (2,18,1) 1883 1939 1884 1940 CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) … … 1899 1955 INTEGER :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn ! dummy indices 1900 1956 INTEGER :: ierr ! allocation error status 1957 INTEGER :: ii,ij,iproc,iprocno,iprocso 1901 1958 1902 1959 … … 1911 1968 jpi_crs = ( jpiglo_crs - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 1912 1969 jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj 1913 1914 IF( noso < 0 ) jpj_crs = jpj_crs + 1 ! add a local band on southern processors 1970 WRITE(narea+200,*)"jpj_crs noso = ", jpj_crs , noso 1971 IF( noso < 0 ) jpj_crs = jpj_crs + 1 ! add a local band on southern processors ! celle qui est faite de zeros 1972 WRITE(narea+200,*)"jpj_crs = ", jpj_crs 1915 1973 1916 1974 jpi_crsm1 = jpi_crs - 1 … … 1941 1999 nlei_crs = jpi_crs 1942 2000 nlej_crs = jpj_crs 1943 1944 ! Calculs suivant une découpage en j 1945 DO jn = 1, jpnij, jpni 1946 IF( jn < ( jpnij - jpni + 1 ) ) THEN 1947 nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn ) - 1) ) / nn_facty, wp ) ) & 1948 & - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 1949 ELSE 1950 nlejt_crs(jn) = AINT( REAL( nlejt(jn) / nn_facty, wp ) ) + 1 2001 2002 !============================================================================================== 2003 ! mpp_ini2 2004 !============================================================================================== 2005 2006 !cbr 2007 DO jn = 1, jpnij 2008 WRITE(narea+200,*)"=====> jn",jn ; call flush(narea+200) 2009 2010 !proc jn 2011 DO ji = 1 , jpni 2012 DO jj = 1 ,jpnj 2013 IF( nfipproc(ji,jj) == jn-1 )THEN 2014 ii=ji 2015 ij=jj 2016 ENDIF 2017 ENDDO 2018 ENDDO 2019 iproc = ii + jpni * ( ij-1 ) - 1 2020 ! mppini : 2021 !iprocso = ii + jpni * ( ij-2 ) - 1 2022 ! mppini2: 2023 IF( ij .GT. 1 )THEN ; iprocso = nfipproc(ii,ij-1) 2024 ELSE ; iprocso = -1 1951 2025 ENDIF 1952 IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 2026 2027 WRITE(narea+200,*)ii,ij ; call flush(narea+200) 2028 WRITE(narea+200,*)"iproc iprocso ",iproc,iprocso 2029 WRITE(narea+200,*)"jpiglo jpjglo ",jpiglo,jpjglo 2030 WRITE(narea+200,*)"ibonit(jn) ibonjt(jn) ",ibonit(jn),ibonjt(jn) ; call flush(narea+200) 2031 WRITE(narea+200,*)"nimppt(jn) njmppt(jn) ",nimppt(jn),njmppt(jn) ; call flush(narea+200) 2032 WRITE(narea+200,*)"loc jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn),nlejt(jn),nlcjt(jn) ; call flush(narea+200) 2033 WRITE(narea+200,*)"glo jpj nldjt(jn),nlejt(jn),nlcjt(jn) ",jpj, nldjt(jn)+njmppt(jn)-1,nlejt(jn)+njmppt(jn)-1,nlcjt(jn) ; call flush(narea+200) 2034 2035 !dimension selon j 2036 !------------------- 2037 IF( ibonjt(jn) .NE. 1 )THEN !on a besoin de savoir si jn est au nord 2038 !iprocno=nfipproc(ii,ij+1) 2039 !iprocno=iprocno+1 2040 WRITE(narea+200,*)"ii,ij+1 ",ii,ij+1; call flush(narea+200) 2041 WRITE(narea+200,*)"njmppt jn njmpptno(jn) ",njmppt(jn),njmpptno(jn); call flush(narea+200) 2042 WRITE(narea+200,*)"jpjglo",jpjglo ; call flush(narea+200) 2043 2044 WRITE(narea+200,*)REAL( ( jpjglo - (njmppt (jn) - 1) ) / nn_facty, wp ),REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ); call flush(narea+200) 2045 WRITE(narea+200,*)AINT( REAL( ( jpjglo - (njmppt (jn) - 1) ) / nn_facty, wp ) ),AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ); call flush(narea+200) 2046 2047 nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt (jn) - 1) ) / nn_facty, wp ) ) & 2048 & - AINT( REAL( ( jpjglo - (njmpptno(jn) - 1) ) / nn_facty, wp ) ) 2049 ELSE ! ibonjt=1 : au nord 2050 nlejt_crs(jn) = AINT( REAL( nlejt(jn) / nn_facty, wp ) ) + 1 2051 ENDIF 2052 !==> nbondj = -1 au sud, 0 au milieu, 1 au nord, 2 si jpnj=1 2053 WRITE(narea+200,*)"nlejt_crs(jn) ",nlejt_crs(jn) ; call flush(narea+200) 2054 !!!noso== nbre de proc sud du proc sur lequel on tourne !!!! ; dangeureux car on est ds une boucle sur jn 2055 IF( iprocso < 0 .AND. ibonjt(jn) == -1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 1953 2056 SELECT CASE( ibonjt(jn) ) 1954 2057 CASE ( -1 ) 1955 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 2058 WRITE(narea+200,*)"MOD( jpjglo - njmppt(jn), nn_facty)",MOD( jpjglo - njmppt(jn), nn_facty) ; call flush(narea+200) 2059 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 ! au cas où il reste des lignes en bas 2060 IF( nldjt(jn) == 1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 1956 2061 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 1957 2062 nldjt_crs(jn) = nldjt(jn) 1958 2063 !???nlejt_crs(jn) = nlejt_crs(jn) + 1 ! 2 !cbr 1959 2064 CASE ( 0 ) 1960 2065 1961 2066 nldjt_crs(jn) = nldjt(jn) 1962 2067 IF( nldjt(jn) == 1 ) nlejt_crs(jn) = nlejt_crs(jn) + 1 1963 2068 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 1964 2069 nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 1965 2070 1966 2071 CASE ( 1, 2 ) 1967 2072 1968 2073 nlejt_crs(jn) = nlejt_crs(jn) + jprecj 1969 2074 nlcjt_crs(jn) = nlejt_crs(jn) 1970 2075 nldjt_crs(jn) = nldjt(jn) 1971 1972 2076 CASE DEFAULT 1973 2077 STOP 1974 2078 END SELECT 1975 IF( nlcjt_crs(jn) > jpj_crs ) jpj_crs = jpj_crs + 1 1976 2079 WRITE(narea+200,*)"jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) " ; call flush(narea+200) 2080 WRITE(narea+200,*) jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 2081 IF( nlcjt_crs(jn) > jpj_crs )THEN 2082 jpj_crs = jpj_crs + 1 2083 nlejt_crs(jn) = nlejt_crs(jn) + 1 2084 ENDIF 2085 !cbr pas bon !!!! 2086 !on augmente la taille des domaines alors que les tblx st deja alloués 2087 !du coup on alloue les tblx apres: 1977 2088 IF(nldjt_crs(jn) == 1 ) THEN 1978 2089 njmppt_crs(jn) = 1 1979 2090 ELSE 1980 2091 njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 1981 ENDIF 1982 1983 DO jj = jn + 1, jn + jpni - 1 1984 nlejt_crs(jj) = nlejt_crs(jn) 1985 nlcjt_crs(jj) = nlcjt_crs(jn) 1986 nldjt_crs(jj) = nldjt_crs(jn) 1987 njmppt_crs(jj)= njmppt_crs(jn) 1988 ENDDO 1989 ENDDO 1990 nlej_crs = nlejt_crs(nproc + 1) 1991 nlcj_crs = nlcjt_crs(nproc + 1) 1992 nldj_crs = nldjt_crs(nproc + 1) 1993 njmpp_crs = njmppt_crs(nproc + 1) 1994 1995 ! Calcul suivant un decoupage en i 1996 DO jn = 1, jpni 1997 IF( jn == 1 ) THEN 2092 ENDIF 2093 WRITE(narea+200,*)"tutu loc ",jn,jpj_crs, nldjt_crs(jn),nlejt_crs(jn),nlcjt_crs(jn) ; call flush(narea+200) 2094 WRITE(narea+200,*)"tutu glo ",jn,jpj_crs, nldjt_crs(jn)+njmppt_crs(jn)-1,nlejt_crs(jn)+njmppt_crs(jn)-1,nlcjt_crs(jn)+njmppt_crs(jn)-1 ; call flush(narea+200) 2095 2096 2097 !dimensions selon i 2098 !------------------- 2099 !IF( jn == 1 ) THEN 2100 !IF( ibonit(jn)==-1 )THEN !on a besoin de savoir si jn est un proc west 2101 IF( ii==1 )THEN !on a besoin de savoir si jn est un proc west 1998 2102 nleit_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + nlcit(jn ) ) / nn_factx, wp) ) 1999 2103 ELSE 2000 nleit_crs(jn) = AINT( REAL( ( nimppt(jn ) - 1 + nlcit(jn ) ) / nn_factx, wp) ) & 2001 & - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) ) / nn_factx, wp) ) 2104 WRITE(narea+200,*)"njmppt jn njmpptea(jn) ",nimppt(jn),nimpptea(jn); call flush(narea+200) 2105 WRITE(narea+200,*)"nlcit (jn) nlcitea(jn) ) ",nlcit (jn),nlcitea(jn); call flush(narea+200) 2106 nleit_crs(jn) = AINT( REAL( ( nimppt (jn) - 1 + nlcit (jn) ) / nn_factx, wp) ) & 2107 & - AINT( REAL( ( nimpptea(jn) - 1 + nlcitea(jn) ) / nn_factx, wp) ) 2002 2108 ENDIF 2109 WRITE(narea+200,*)"nleji_crs(jn),noso ",nleit_crs(jn); call flush(narea+200) 2110 2003 2111 2004 2112 SELECT CASE( ibonit(jn) ) 2005 2113 CASE ( -1 ) 2006 nleit_crs(jn) = nleit_crs(jn) + jpreci 2114 nleit_crs(jn) = nleit_crs(jn) + jpreci 2007 2115 nlcit_crs(jn) = nleit_crs(jn) + jpreci 2008 nldit_crs(jn) = nldit(jn) 2009 2116 nldit_crs(jn) = nldit(jn) 2117 2010 2118 CASE ( 0 ) 2011 2119 nleit_crs(jn) = nleit_crs(jn) + jpreci 2012 2120 nlcit_crs(jn) = nleit_crs(jn) + jpreci 2013 nldit_crs(jn) = nldit(jn) 2014 2121 nldit_crs(jn) = nldit(jn) 2122 2015 2123 CASE ( 1, 2 ) 2016 2124 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 ) nleit_crs(jn) = nleit_crs(jn) + 1 2017 2125 nleit_crs(jn) = nleit_crs(jn) + jpreci 2018 2126 nlcit_crs(jn) = nleit_crs(jn) 2019 nldit_crs(jn) = nldit(jn) 2127 nldit_crs(jn) = nldit(jn) 2020 2128 2021 2129 CASE DEFAULT 2022 2130 STOP 2023 2131 END SELECT 2024 2132 WRITE(narea+200,*)"jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ",jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 2025 2133 nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 2026 DO jj = jn + jpni , jpnij, jpni 2027 nleit_crs(jj) = nleit_crs(jn) 2028 nlcit_crs(jj) = nlcit_crs(jn) 2029 nldit_crs(jj) = nldit_crs(jn) 2030 nimppt_crs(jj)= nimppt_crs(jn) 2031 ENDDO 2032 ENDDO 2033 2034 nlei_crs = nleit_crs(nproc + 1) 2035 nlci_crs = nlcit_crs(nproc + 1) 2036 nldi_crs = nldit_crs(nproc + 1) 2037 nimpp_crs = nimppt_crs(nproc + 1) 2134 2135 WRITE(narea+200,*)"tutu loc ",jn,jpi_crs, nldit_crs(jn),nleit_crs(jn),nlcit_crs(jn) ; call flush(narea+200) 2136 WRITE(narea+200,*)"tutu glo ",jn,jpi_crs, nldit_crs(jn)+nimppt_crs(jn)-1,nleit_crs(jn)+nimppt_crs(jn)-1,nlcit_crs(jn)+nimppt_crs(jn)-1 ; call flush(narea+200) 2137 2138 2139 ENDDO 2140 2141 nlej_crs = nlejt_crs(nproc + 1) 2142 nlcj_crs = nlcjt_crs(nproc + 1) 2143 nldj_crs = nldjt_crs(nproc + 1) 2144 njmpp_crs = njmppt_crs(nproc + 1) 2145 2146 nlei_crs = nleit_crs(nproc + 1) 2147 nlci_crs = nlcit_crs(nproc + 1) 2148 nldi_crs = nldit_crs(nproc + 1) 2149 nimpp_crs = nimppt_crs(nproc + 1) 2150 2151 !============================================================================================== 2152 write(narea+200,*)"jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1" ; call flush(narea+200) 2153 write(narea+200,*)jpi_crs,nldi_crs,nlei_crs,nlci_crs,nimpp_crs,nldi_crs+nimpp_crs-1,nlei_crs+nimpp_crs-1 ; call flush(narea+200) 2154 write(narea+200,*)"jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1" ; call flush(narea+200) 2155 write(narea+200,*)jpj_crs,nldj_crs,nlej_crs,nlcj_crs,njmpp_crs,nldj_crs+njmpp_crs-1,nlej_crs+njmpp_crs-1 ; call flush(narea+200) 2038 2156 2039 2157 ! No coarsening with zoom 2040 2158 IF( jpizoom /= 1 .OR. jpjzoom /= 1) STOP 2041 2159 2160 !cbr 2161 ierr = crs_dom_alloc1() 2162 2042 2163 DO ji = 1, jpi_crs 2043 2164 mig_crs(ji) = ji + nimpp_crs - 1 2165 WRITE(narea+200,*)"fifi ",ji,mig_crs(ji) ; call flush(narea+200) 2044 2166 ENDDO 2045 2167 DO jj = 1, jpj_crs 2046 2168 mjg_crs(jj) = jj + njmpp_crs - 1! 2169 WRITE(narea+200,*)"fufu ",jj,mjg_crs(jj) ; call flush(narea+200) 2047 2170 ENDDO 2048 2171 … … 2050 2173 mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 2051 2174 mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs ) ) 2175 WRITE(narea+200,*)"mi ",ji,mi0_crs(ji),mi1_crs(ji) ; call flush(narea+200) 2052 2176 ENDDO 2053 2177 … … 2055 2179 mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 2056 2180 mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs ) ) 2181 WRITE(narea+200,*)"mj ",jj, mj0_crs(jj),mj1_crs(jj) ; call flush(narea+200) 2057 2182 ENDDO 2058 2183 … … 2171 2296 mjs2_crs(jpjglo_crs-jj+2) = ijjs 2172 2297 mje2_crs(jpjglo_crs-jj+2) = ijje 2298 WRITE(narea+200,*)"jpjglo_crs-jj+2,ijje,ijjs ",jpjglo_crs-jj+2,ijjs,ijje ; call flush(narea+200) 2173 2299 ENDDO 2174 2300 … … 2200 2326 ijjs = ijje - nn_facty + 1 2201 2327 IF ( ijjs <= nn_facty ) ijjs = 2 2328 WRITE(narea+200,*)"fufu",jj,ijjs,ijje ; call flush(narea+200) 2202 2329 mjs2_crs(jpj_crs-jj+1) = ijjs 2203 2330 mje2_crs(jpj_crs-jj+1) = ijje … … 2230 2357 mje_crs(:) = mje2_crs(:) 2231 2358 ELSE 2359 write(narea+200,*)"njmpp ",njmpp 2232 2360 DO jj = 1, nlej_crs 2361 write(narea+200,*)jj,"mjs2_crs mje2_crs ",mjg_crs(jj),mjs2_crs(mjg_crs(jj)),mje2_crs(mjg_crs(jj)) ; call flush(narea+200) 2233 2362 mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 2234 2363 mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 2364 write(narea+200,*)"mjs_crs mje_crs ",mjs_crs(jj),mje_crs(jj) ; call flush(narea+200) 2235 2365 ENDDO 2366 write(narea+200,*)"nimpp ",nimpp 2236 2367 DO ji = 1, nlei_crs 2368 write(narea+200,*)ji,"mis2_crs mie2_crs ",mig_crs(ji),mis2_crs(mig_crs(ji)),mie2_crs(mig_crs(ji)) ; call flush(narea+200) 2237 2369 mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 2238 2370 mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 2371 write(narea+200,*)"mis_crs mie_crs ",mis_crs(jj),mie_crs(jj) ; call flush(narea+200) 2239 2372 ENDDO 2240 2373 ENDIF 2241 2374 ! 2375 IF( nlcj_crs -1 .GT. nlej_crs )WRITE(narea+200,*)"tutututu",nlcj_crs,nlej_crs ; call flush(narea+200) 2242 2376 nistr = mis_crs(2) ; niend = mis_crs(nlci_crs - 1) 2243 2377 njstr = mjs_crs(3) ; njend = mjs_crs(nlcj_crs - 1)
Note: See TracChangeset
for help on using the changeset viewer.
