Changeset 956 for LMDZ4/trunk/libf/phy_IPCC_AR4/phyetat0.F
- Timestamp:
- May 9, 2008, 6:17:59 PM (17 years ago)
- File:
-
- 1 edited
-
LMDZ4/trunk/libf/phy_IPCC_AR4/phyetat0.F (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phy_IPCC_AR4/phyetat0.F
r868 r956 7 7 . rlat_p, rlon_p, pctsrf_p, tsol_p, 8 8 . ocean_in, ok_veget_in, 9 . alb e_p, alblw_p,9 . alb1_p, alb2_p, 10 10 . rain_fall_p, snow_fall_p,solsw_p, sollw_p, 11 11 . radsol_p,clesphy0, … … 37 37 #include "clesphys.h" 38 38 #include "temps.h" 39 #include "thermcell.h" 40 #include "compbl.h" 39 41 c====================================================================== 40 42 CHARACTER*(*) fichnom … … 50 52 REAL qsol_p(klon) 51 53 REAL snow_p(klon,nbsrf) 52 REAL albe_p(klon,nbsrf) 53 cIM BEG alblw 54 REAL alblw_p(klon,nbsrf) 55 cIM END alblw 54 REAL alb1_p(klon,nbsrf) ! albedo in visible SW interval 55 REAL alb2_p(klon,nbsrf) ! albedo in near IR interval 56 56 REAL evap_p(klon,nbsrf) 57 57 REAL radsol_p(klon) … … 89 89 REAL qsol(klon_glo) 90 90 REAL snow(klon_glo,nbsrf) 91 REAL alb e(klon_glo,nbsrf)92 REAL alb lw(klon_glo,nbsrf)91 REAL alb1(klon_glo,nbsrf) 92 REAL alb2(klon_glo,nbsrf) 93 93 REAL evap(klon_glo,nbsrf) 94 94 REAL radsol(klon_glo) … … 127 127 c 128 128 INTEGER nid, nvarid 129 INTEGER ierr, i, nsrf, isoil 129 INTEGER ierr, i, nsrf, isoil ,k 130 130 INTEGER length 131 131 PARAMETER (length=100) … … 134 134 CHARACTER*7 str7 135 135 CHARACTER*2 str2 136 real iolat(jjm+1) 136 137 c FH1D 138 c real iolat(jjm+1) 139 real iolat(jjm+1-1/iim) 137 140 c 138 141 c Ouvrir le fichier contenant l'etat initial: … … 181 184 182 185 c 183 186 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 187 ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique 188 ! Les constantes de la physiques sont lues dans la physique seulement. 189 ! Les egalites du type 190 ! tab_cntrl( 5 )=clesphy0(1) 191 ! sont remplacees par 192 ! clesphy0(1)=tab_cntrl( 5 ) 193 ! On inverse aussi la logique. 194 ! On remplit les tab_cntrl avec les parametres lus dans les .def 195 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 196 184 197 DO i = 1, length 185 198 tabcntr0( i ) = tab_cntrl( i ) 186 199 ENDDO 187 200 c 188 cycle_diurne = .FALSE. 189 soil_model = .FALSE. 190 new_oliq = .FALSE. 191 ok_orodr = .FALSE. 192 ok_orolf = .FALSE. 193 ok_limitvrai = .FALSE. 194 195 196 IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN 197 tab_cntrl( 5 ) = clesphy0(1) 198 ENDIF 199 200 IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN 201 tab_cntrl( 6 ) = clesphy0(2) 202 ENDIF 203 204 IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN 205 tab_cntrl( 7 ) = clesphy0(3) 206 ENDIF 207 208 IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN 209 tab_cntrl( 8 ) = clesphy0(4) 210 ENDIF 211 212 IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN 213 tab_cntrl( 9 ) = clesphy0( 5 ) 214 ENDIF 215 216 IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN 217 tab_cntrl( 10 ) = clesphy0( 6 ) 218 ENDIF 219 220 IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN 221 tab_cntrl( 11 ) = clesphy0( 7 ) 222 ENDIF 223 224 IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN 225 tab_cntrl( 12 ) = clesphy0( 8 ) 226 ENDIF 227 228 229 dtime = tab_cntrl(1) 230 radpas = tab_cntrl(2) 201 tab_cntrl(1)=dtime 202 tab_cntrl(2)=radpas 231 203 co2_ppm_etat0 = tab_cntrl(3) 232 204 solaire_etat0 = tab_cntrl(4) 233 iflag_con = tab_cntrl(5) 234 nbapp_rad = tab_cntrl(6) 235 236 237 cycle_diurne = .FALSE. 238 soil_model = .FALSE. 239 new_oliq = .FALSE. 240 ok_orodr = .FALSE. 241 ok_orolf = .FALSE. 242 ok_limitvrai = .FALSE. 243 244 IF( tab_cntrl( 7) .EQ. 1. ) cycle_diurne = .TRUE. 245 IF( tab_cntrl( 8) .EQ. 1. ) soil_model = .TRUE. 246 IF( tab_cntrl( 9) .EQ. 1. ) new_oliq = .TRUE. 247 IF( tab_cntrl(10) .EQ. 1. ) ok_orodr = .TRUE. 248 IF( tab_cntrl(11) .EQ. 1. ) ok_orolf = .TRUE. 249 IF( tab_cntrl(12) .EQ. 1. ) ok_limitvrai = .TRUE. 205 tab_cntrl(5)=iflag_con 206 tab_cntrl(6)=nbapp_rad 207 208 if (cycle_diurne) tab_cntrl( 7) =1. 209 if (soil_model) tab_cntrl( 8) =1. 210 if (new_oliq) tab_cntrl( 9) =1. 211 if (ok_orodr) tab_cntrl(10) =1. 212 if (ok_orolf) tab_cntrl(11) =1. 213 if (ok_limitvrai) tab_cntrl(12) =1. 250 214 251 215 252 216 itau_phy = tab_cntrl(15) 217 218 219 220 IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN 221 clesphy0(1)=tab_cntrl( 5 ) 222 ENDIF 223 224 IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN 225 clesphy0(2)=tab_cntrl( 6 ) 226 ENDIF 227 228 IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN 229 clesphy0(3)=tab_cntrl( 7 ) 230 ENDIF 231 232 IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN 233 clesphy0(4)=tab_cntrl( 8 ) 234 ENDIF 235 236 IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN 237 clesphy0(5)=tab_cntrl( 9 ) 238 ENDIF 239 240 IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN 241 clesphy0(6)=tab_cntrl( 10 ) 242 ENDIF 243 244 IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN 245 clesphy0(7)=tab_cntrl( 11 ) 246 ENDIF 247 248 IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN 249 clesphy0(8)=tab_cntrl( 12 ) 250 ENDIF 251 253 252 254 253 c … … 721 720 ENDIF 722 721 c 723 c Lecture de albedo au sol:722 c Lecture de albedo de l'interval visible au sol: 724 723 c 725 724 ierr = NF_INQ_VARID (nid, "ALBE", nvarid) … … 739 738 ENDIF 740 739 #ifdef NC_DOUBLE 741 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb e(1,nsrf))742 #else 743 ierr = NF_GET_VAR_REAL(nid, nvarid, alb e(1,nsrf))740 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,nsrf)) 741 #else 742 ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,nsrf)) 744 743 #endif 745 744 IF (ierr.NE.NF_NOERR) THEN … … 750 749 xmax = -1.0E+20 751 750 DO i = 1, klon_glo 752 xmin = MIN(alb e(i,nsrf),xmin)753 xmax = MAX(alb e(i,nsrf),xmax)751 xmin = MIN(alb1(i,nsrf),xmin) 752 xmax = MAX(alb1(i,nsrf),xmax) 754 753 ENDDO 755 754 PRINT*,'Albedo du sol ALBE**:', nsrf, xmin, xmax … … 759 758 PRINT*, ' J ignore donc les autres ALBE**' 760 759 #ifdef NC_DOUBLE 761 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb e(1,1))762 #else 763 ierr = NF_GET_VAR_REAL(nid, nvarid, alb e(1,1))760 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb1(1,1)) 761 #else 762 ierr = NF_GET_VAR_REAL(nid, nvarid, alb1(1,1)) 764 763 #endif 765 764 IF (ierr.NE.NF_NOERR) THEN … … 770 769 xmax = -1.0E+20 771 770 DO i = 1, klon_glo 772 xmin = MIN(alb e(i,1),xmin)773 xmax = MAX(alb e(i,1),xmax)771 xmin = MIN(alb1(i,1),xmin) 772 xmax = MAX(alb1(i,1),xmax) 774 773 ENDDO 775 774 PRINT*,'Neige du sol <ALBE>', xmin, xmax 776 775 DO nsrf = 2, nbsrf 777 776 DO i = 1, klon_glo 778 alb e(i,nsrf) = albe(i,1)779 ENDDO 780 ENDDO 781 ENDIF 782 783 c 784 c Lecture de albedo au sol LW:777 alb1(i,nsrf) = alb1(i,1) 778 ENDDO 779 ENDDO 780 ENDIF 781 782 c 783 c Lecture de albedo au sol dans l'interval proche infra-rouge: 785 784 c 786 785 ierr = NF_INQ_VARID (nid, "ALBLW", nvarid) … … 791 790 DO nsrf = 1, nbsrf 792 791 DO i = 1, klon_glo 793 alb lw(i,nsrf) = albe(i,nsrf)792 alb2(i,nsrf) = alb1(i,nsrf) 794 793 ENDDO 795 794 ENDDO … … 798 797 PRINT*, ' J ignore donc les autres ALBLW**' 799 798 #ifdef NC_DOUBLE 800 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb lw(1,1))801 #else 802 ierr = NF_GET_VAR_REAL(nid, nvarid, alb lw(1,1))799 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb2(1,1)) 800 #else 801 ierr = NF_GET_VAR_REAL(nid, nvarid, alb2(1,1)) 803 802 #endif 804 803 IF (ierr.NE.NF_NOERR) THEN … … 809 808 xmax = -1.0E+20 810 809 DO i = 1, klon_glo 811 xmin = MIN(alb lw(i,1),xmin)812 xmax = MAX(alb lw(i,1),xmax)810 xmin = MIN(alb2(i,1),xmin) 811 xmax = MAX(alb2(i,1),xmax) 813 812 ENDDO 814 813 PRINT*,'Neige du sol <ALBLW>', xmin, xmax 815 814 DO nsrf = 2, nbsrf 816 815 DO i = 1, klon_glo 817 alb lw(i,nsrf) = alblw(i,1)816 alb2(i,nsrf) = alb2(i,1) 818 817 ENDDO 819 818 ENDDO … … 1427 1426 1428 1427 c 1429 ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)1430 IF (ierr.NE.NF_NOERR) THEN1431 PRINT*, "phyetat0: Le champ <QANCIEN> est absent"1432 PRINT*, "Depart legerement fausse. Mais je continue"1433 ancien_ok = .FALSE.1434 ELSE1435 #ifdef NC_DOUBLE1436 ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)1437 #else1438 ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)1439 #endif1440 IF (ierr.NE.NF_NOERR) THEN1441 PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"1442 CALL abort1443 ENDIF1444 ENDIF1445 c1446 1428 c Lecture ratqs 1447 1429 c … … 1492 1474 xmax = MAXval(run_off_lic_0) 1493 1475 PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax 1494 c 1476 1477 1495 1478 c Fermer le fichier: 1496 1479 c … … 1503 1486 cym en attendant mieux 1504 1487 iolat(1)=rlat(1) 1505 iolat(jjm+1)=rlat(klon_glo) 1488 1489 !FH1D 1490 !iolat(jjm+1)=rlat(klon_glo) 1491 iolat(jjm+1-1/iim)=rlat(klon_glo) 1492 if (iim.gt.1) then 1506 1493 do i=2,jjm 1507 1494 iolat(i)=rlat(2+(i-2)*iim) 1508 1495 enddo 1496 endif 1497 1509 1498 CALL bcast_mpi(iolat) 1510 1499 CALL bcast_mpi(rlon) 1511 call init_iophy(iolat,rlon(2:iim+1)) 1500 1501 !FH1D 1502 ! call init_iophy(iolat,rlon(2:iim+1)) 1503 call init_iophy(iolat,rlon(2-1/iim:iim+1-1/iim)) 1512 1504 1513 1505 c$OMP END MASTER … … 1522 1514 call Scatter( qsol,qsol_p) 1523 1515 call Scatter( snow,snow_p) 1524 call Scatter( alb e,albe_p)1525 call Scatter( alb lw,alblw_p)1516 call Scatter( alb1,alb1_p) 1517 call Scatter( alb2,alb2_p) 1526 1518 call Scatter( evap,evap_p) 1527 1519 call Scatter( radsol,radsol_p)
Note: See TracChangeset
for help on using the changeset viewer.
