Changeset 325 for LMDZ.3.3/branches/rel-LF/libf/dyn3d/limit_netcdf.F
- Timestamp:
- Jan 30, 2002, 8:38:26 PM (23 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/dyn3d/limit_netcdf.F
r320 r325 2 2 C $Header$ 3 3 C 4 SUBROUTINE limit_netcdf ( interbar, extrap, oldice, masque)4 SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf) 5 5 c 6 6 IMPLICIT none … … 29 29 #include "comconst.h" 30 30 #include "dimphy.h" 31 #include "indicesol.h" 31 32 c 32 33 c----------------------------------------------------------------------- 33 34 LOGICAL interbar, extrap, oldice 34 35 35 INTEGER KIDIA, KFDIA, KLON, KLEV36 c-----------------------------------------------------------------------37 36 REAL phy_nat(klon,360), phy_nat0(klon) 38 37 REAL phy_alb(klon,360) … … 42 41 REAL phy_ice(klon,360) 43 42 c 43 real pctsrf_t(klon,nbsrf,360) 44 real pctsrf(klon,nbsrf) 45 REAL verif 46 44 47 REAL masque(iip1,jjp1) 45 48 REAL mask(iim,jjp1) 49 CPB 50 C newlmt indique l'utilisation de la sous-maille fractionnelle 51 C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3) 52 LOGICAL newlmt, fracterre 53 PARAMETER(newlmt=.TRUE.) 54 PARAMETER(fracterre = .TRUE.) 46 55 47 56 C Declarations pour le champ de depart … … 83 92 INTEGER id_tim 84 93 INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB 85 86 INTEGER i, j, k, l 94 CPB 95 INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC 96 97 INTEGER i, j, k, l, ji 98 c declarations pour lecture glace de mer 99 INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret 100 INTEGER :: itaul(1), fid 101 REAL :: lev(1), date, dt 102 REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic 103 REAL, ALLOCATABLE, DIMENSION(:) :: dlon_lic, dlat_lic 104 REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic 105 REAL :: flic_tmp(iip1, jjp1) 106 87 107 c Diverses variables locales 88 108 REAL time 109 ! pour la lecture du fichier masque ocean 110 integer :: nid_o2a 111 logical :: couple = .false. 112 INTEGER :: iml_omask, jml_omask 113 REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask 114 REAL, ALLOCATABLE, DIMENSION(:) :: dlon_omask, dlat_omask 115 REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp 116 real, dimension(klon) :: ocemask_fi 89 117 90 118 INTEGER longcles … … 94 122 INTEGER ncid,varid,ndimid(4),dimid 95 123 character*30 namedim 124 CHARACTER*80 :: varname 125 126 c initialisations: 127 CALL conf_gcm( 99, .TRUE. , clesphy0 ) 128 96 129 97 130 pi = 4. * ATAN(1.) … … 103 136 cpp = 1004.70885 104 137 dtvr = daysec/FLOAT(day_step) 138 CALL inigeom 105 139 c 106 140 C Traitement du relief au sol … … 589 623 CALL gr_dyn_fi(1, iip1, jjp1, klon, 590 624 . champan(1,1,k), phy_ice(1,k)) 591 DO i = 1, klon 592 phy_nat(i,k) = zmasq(i) 593 IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN 594 IF (NINT(zmasq(i)).EQ.0) THEN 595 phy_nat(i,k) = 3.0 596 ELSE 597 phy_nat(i,k) = 2.0 598 ENDIF 625 IF ( newlmt) THEN 626 627 CPB en attendant de mettre fraction de terre 628 c 629 WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1. 630 WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0. 631 c 632 IF (fracterre ) THEN 633 c WRITE(*,*) 'passe dans cas fracterre' 634 pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter) 635 pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic) 636 pctsrf_t(1:klon,is_sic,k) = phy_ice(1:klon) 637 $ - pctsrf_t(1:klon,is_lic,k) 638 c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP 639 WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0) 640 pctsrf_t(1:klon,is_sic,k) = 0. 641 END WHERE 642 WHERE( 1. - zmasq(1:klon) .LT. EPSFRA) 643 pctsrf_t(1:klon,is_sic,k) = 0. 644 pctsrf_t(1:klon,is_oce,k) = 0. 645 END WHERE 646 DO i = 1, klon 647 IF ( 1. - zmasq(i) .GT. EPSFRA) THEN 648 IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN 649 pctsrf_t(i,is_sic,k) = 1 - zmasq(i) 650 pctsrf_t(i,is_oce,k) = 0. 651 ELSE 652 pctsrf_t(i,is_oce,k) = 1 - zmasq(i) 653 $ - pctsrf_t(i,is_sic,k) 654 IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN 655 pctsrf_t(i,is_oce,k) = 0. 656 pctsrf_t(i,is_sic,k) = 1 - zmasq(i) 657 ENDIF 658 ENDIF 659 ENDIF 660 if (pctsrf_t(i,is_oce,k) .lt. 0.) then 661 WRITE(*,*) 'pb sous maille au point : i,k ' 662 $ , i,k,pctsrf_t(:,is_oce,k) 663 ENDIF 664 IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) + 665 $ pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k) - 1.) 666 $ .GT. EPSFRA) THEN 667 WRITE(*,*) 'physiq : pb sous surface au point ', i, 668 $ pctsrf_t(i, 1 : nbsrf,k), phy_ice(i) 669 ENDIF 670 END DO 671 ELSE 672 DO i = 1, klon 673 pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter) 674 IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN 675 pctsrf_t(i,is_sic,k) = 0. 676 pctsrf_t(i,is_oce,k) = 0. 677 IF(phy_ice(i) .GE. 1.e-5) THEN 678 pctsrf_t(i,is_lic,k) = phy_ice(i) 679 pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k) 680 . - pctsrf_t(i,is_lic,k) 681 ELSE 682 pctsrf_t(i,is_lic,k) = 0. 683 ENDIF 684 ELSE 685 pctsrf_t(i,is_lic,k) = 0. 686 IF(phy_ice(i) .GE. 1.e-5) THEN 687 pctsrf_t(i,is_ter,k) = 0. 688 pctsrf_t(i,is_sic,k) = phy_ice(i) 689 pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k) 690 ELSE 691 pctsrf_t(i,is_sic,k) = 0. 692 pctsrf_t(i,is_oce,k) = 1. 693 ENDIF 694 ENDIF 695 verif = pctsrf_t(i,is_ter,k) + 696 . pctsrf_t(i,is_oce,k) + 697 . pctsrf_t(i,is_sic,k) + 698 . pctsrf_t(i,is_lic,k) 699 IF ( verif .LT. 1. - 1.e-5 .OR. 700 $ verif .GT. 1 + 1.e-5) THEN 701 WRITE(*,*) 'pb sous maille au point : i,k,verif ' 702 $ , i,k,verif 703 ENDIF 704 END DO 705 ENDIF 706 ELSE 707 DO i = 1, klon 708 phy_nat(i,k) = phy_nat0(i) 709 IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN 710 IF (NINT(phy_nat0(i)).EQ.0) THEN 711 phy_nat(i,k) = 3.0 712 ELSE 713 phy_nat(i,k) = 2.0 714 ENDIF 599 715 ENDIF 600 716 IF( NINT(phy_nat(i,k)).EQ.0 ) THEN 601 717 IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001 602 718 ENDIF 603 ENDDO604 719 END DO 720 ENDIF 605 721 ENDDO 606 722 c … … 1004 1120 dims(2) = ntim 1005 1121 c 1006 ccc ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)1007 1122 ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim) 1008 1123 ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17, 1009 1124 . "Jour dans l annee") 1010 ccc ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT) 1011 ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT) 1012 ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23, 1013 . "Nature du sol (0,1,2,3)") 1014 ccc ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST) 1125 IF (newlmt) THEN 1126 c 1127 ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE) 1128 ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14, 1129 . "Fraction ocean") 1130 c 1131 ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC) 1132 ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21, 1133 . "Fraction glace de mer") 1134 c 1135 ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER) 1136 ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14, 1137 . "Fraction terre") 1138 c 1139 ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC) 1140 ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17, 1141 . "Fraction land ice") 1142 c 1143 ELSE 1144 ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT) 1145 ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23, 1146 . "Nature du sol (0,1,2,3)") 1147 ENDIF 1015 1148 ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST) 1016 1149 ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35, 1017 . "Temperature superficielle de la mer") 1018 ccc ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS) 1150 . "Temperature superficielle de la mer") 1019 1151 ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS) 1020 1152 ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32, 1021 1153 . "Reference flux de chaleur au sol") 1022 ccc ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)1023 1154 ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB) 1024 1155 ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19, 1025 1156 . "Albedo a la surface") 1026 ccc ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)1027 1157 ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG) 1028 1158 ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8, … … 1040 1170 #ifdef NC_DOUBLE 1041 1171 ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k)) 1042 ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k)) 1172 c 1173 IF (newlmt ) THEN 1174 ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais 1175 $ ,pctsrf_t(1,is_oce,k)) 1176 ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais 1177 $ ,pctsrf_t(1,is_sic,k)) 1178 ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais 1179 $ ,pctsrf_t(1,is_ter,k)) 1180 ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais 1181 $ ,pctsrf_t(1,is_lic,k)) 1182 ELSE 1183 ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais 1184 $ ,phy_nat(1,k)) 1185 ENDIF 1186 c 1043 1187 ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k)) 1044 1188 ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k)) … … 1047 1191 #else 1048 1192 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k)) 1049 ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k)) 1193 IF (newlmt ) THEN 1194 ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais 1195 $ ,pctsrf_t(1,is_oce,k)) 1196 ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais 1197 $ ,pctsrf_t(1,is_sic,k)) 1198 ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais 1199 $ ,pctsrf_t(1,is_ter,k)) 1200 ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais 1201 $ ,pctsrf_t(1,is_lic,k)) 1202 ELSE 1203 ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais 1204 $ ,phy_nat(1,k)) 1205 ENDIF 1050 1206 ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k)) 1051 1207 ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
Note: See TracChangeset
for help on using the changeset viewer.
