Changeset 146 for trunk/LMDZ.MARS/libf/dyn3d
- Timestamp:
- Jun 8, 2011, 12:04:26 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/dyn3d/lect_start_archive.F
r38 r146 185 185 integer :: counter 186 186 character(len=30) :: txt ! to store some text 187 real :: tmpval ! to store a temporary variable/value 187 188 188 189 c======================================================================= … … 350 351 ierr = NF_INQ_VARID (nid, "controle", nvarid) 351 352 IF (ierr .NE. NF_NOERR) THEN 352 PRINT*, "Lect_start_archive: champ <controle> est absent"353 PRINT*, "Lect_start_archive: <controle> is missing" 353 354 CALL abort 354 355 ENDIF … … 359 360 #endif 360 361 IF (ierr .NE. NF_NOERR) THEN 361 PRINT*, "lect_start_archive: Lecture echoue pour<controle>"362 PRINT*, "lect_start_archive: Failed loading <controle>" 362 363 CALL abort 363 364 ENDIF … … 371 372 ierr = NF_INQ_VARID (nid, "rlonv", nvarid) 372 373 IF (ierr .NE. NF_NOERR) THEN 373 PRINT*, "lect_start_archive: Le champ <rlonv> est absent"374 PRINT*, "lect_start_archive: <rlonv> is missing" 374 375 CALL abort 375 376 ENDIF … … 380 381 #endif 381 382 IF (ierr .NE. NF_NOERR) THEN 382 PRINT*, "lect_start_archive: Lecture echouee pour<rlonv>"383 PRINT*, "lect_start_archive: Failed loading <rlonv>" 383 384 CALL abort 384 385 ENDIF … … 386 387 ierr = NF_INQ_VARID (nid, "rlatu", nvarid) 387 388 IF (ierr .NE. NF_NOERR) THEN 388 PRINT*, "lect_start_archive: Le champ <rlatu> est absent"389 PRINT*, "lect_start_archive: <rlatu> is missing" 389 390 CALL abort 390 391 ENDIF … … 395 396 #endif 396 397 IF (ierr .NE. NF_NOERR) THEN 397 PRINT*, "lect_start_archive: Lecture echouee pour<rlatu>"398 PRINT*, "lect_start_archive: Failed loading <rlatu>" 398 399 CALL abort 399 400 ENDIF … … 401 402 ierr = NF_INQ_VARID (nid, "rlonu", nvarid) 402 403 IF (ierr .NE. NF_NOERR) THEN 403 PRINT*, "lect_start_archive: Le champ <rlonu> est absent"404 PRINT*, "lect_start_archive: <rlonu> is missing" 404 405 CALL abort 405 406 ENDIF … … 410 411 #endif 411 412 IF (ierr .NE. NF_NOERR) THEN 412 PRINT*, "lect_start_archive: Lecture echouee pour<rlonu>"413 PRINT*, "lect_start_archive: Failed loading <rlonu>" 413 414 CALL abort 414 415 ENDIF … … 416 417 ierr = NF_INQ_VARID (nid, "rlatv", nvarid) 417 418 IF (ierr .NE. NF_NOERR) THEN 418 PRINT*, "lect_start_archive: Le champ <rlatv> est absent"419 PRINT*, "lect_start_archive: <rlatv> is missing" 419 420 CALL abort 420 421 ENDIF … … 425 426 #endif 426 427 IF (ierr .NE. NF_NOERR) THEN 427 PRINT*, "lect_start_archive: Lecture echouee pour<rlatv>"428 PRINT*, "lect_start_archive: Failed loading <rlatv>" 428 429 CALL abort 429 430 ENDIF … … 436 437 ierr = NF_INQ_VARID (nid, "aps", nvarid) 437 438 IF (ierr .NE. NF_NOERR) THEN 438 PRINT*, "lect_start_archive: Le champ <aps> est absent"439 PRINT*, "lect_start_archive: <aps> is missing" 439 440 apsold=0 440 441 PRINT*, "<aps> set to 0" … … 446 447 #endif 447 448 IF (ierr .NE. NF_NOERR) THEN 448 PRINT*, "lect_start_archive: Lecture echouee pour<aps>"449 PRINT*, "lect_start_archive: Failed loading <aps>" 449 450 ENDIF 450 451 ENDIF … … 452 453 ierr = NF_INQ_VARID (nid, "bps", nvarid) 453 454 IF (ierr .NE. NF_NOERR) THEN 454 PRINT*, "lect_start_archive: Le champ <bps> est absent"455 PRINT*, "lect_start_archive: <bps> is missing" 455 456 PRINT*, "It must be an old start_archive, lets look for sig_s" 456 457 ierr = NF_INQ_VARID (nid, "sig_s", nvarid) … … 466 467 #endif 467 468 IF (ierr .NE. NF_NOERR) THEN 468 PRINT*, "lect_start_archive: Lecture echouee pour<bps>"469 PRINT*, "lect_start_archive: Failed loading <bps>" 469 470 CALL abort 470 471 END IF … … 555 556 ierr = NF_INQ_VARID (nid, "phisinit", nvarid) 556 557 IF (ierr .NE. NF_NOERR) THEN 557 PRINT*, "lect_start_archive: Le champ <phisinit> est absent"558 PRINT*, "lect_start_archive: <phisinit> is missing" 558 559 CALL abort 559 560 ENDIF … … 564 565 #endif 565 566 IF (ierr .NE. NF_NOERR) THEN 566 PRINT*, "lect_start_archive: Lecture echouee pour<phisinit>"567 PRINT*, "lect_start_archive: Failed loading <phisinit>" 567 568 CALL abort 568 569 ENDIF … … 584 585 ierr = NF_INQ_DIMID (nid, "temps", nvarid) 585 586 IF (ierr .NE. NF_NOERR) THEN 586 PRINT*, "lect_start_archive: Le champ <Time> est absent"587 PRINT*, "lect_start_archive: <Time> is missing" 587 588 CALL abort 588 589 endif … … 599 600 #endif 600 601 IF (ierr .NE. NF_NOERR) THEN 601 PRINT*, "lect_start_archive: Lecture echouee pour<Time>"602 PRINT*, "lect_start_archive: Failed loading <Time>" 602 603 CALL abort 603 604 ENDIF … … 605 606 write(*,*) 606 607 write(*,*) 607 write(*,*) 'D ifferentes dates des etats initiaux stockes:'608 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~'608 write(*,*) 'Dates of the stored initial states:' 609 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 609 610 pi=2.*ASIN(1.) 610 611 do i=1,timelen 611 612 c call solarlong(timelist(i),sollong(i)) 612 613 c sollong(i) = sollong(i)*180./pi 613 write(*,*) ' etat initial au jour martien',int(timelist(i))614 write(*,*) 'initial state at martian day: ',int(timelist(i)) 614 615 c write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)), 615 616 c . sollong(i) … … 619 620 620 621 write(*,*) 621 write(*,*) 'Cho ix de la date'622 write(*,*) 'Choose the martian day to use' 622 623 123 read(*,*,iostat=ierr) date 623 624 if(ierr.ne.0) goto 123 … … 632 633 write(*,*) 633 634 write(*,*) 634 write(*,*) ' He alors... Y sait pas lire !?!'635 write(*,*) 'Wrong value for day number !!' 635 636 write(*,*) 636 write(*,*) 'D ifferentes dates des etats initiaux stockes:'637 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~'637 write(*,*) 'Dates of the stored initial states:' 638 write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 638 639 do i=1,timelen 639 write(*,*) ' etat initial au jour martien',nint(timelist(i))640 write(*,*) 'initial state at martian day: ',nint(timelist(i)) 640 641 c write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)) 641 642 end do … … 657 658 ierr = NF_INQ_VARID (nid, "co2ice", nvarid) 658 659 IF (ierr .NE. NF_NOERR) THEN 659 PRINT*, "lect_start_archive: Le champ <co2ice> est absent"660 PRINT*, "lect_start_archive: <co2ice> is missing" 660 661 CALL abort 661 662 ENDIF … … 666 667 #endif 667 668 IF (ierr .NE. NF_NOERR) THEN 668 PRINT*, "lect_start_archive: Lecture echouee pour<co2ice>"669 PRINT*, "lect_start_archive: Failed loading <co2ice>" 669 670 PRINT*, NF_STRERROR(ierr) 670 671 CALL abort … … 673 674 ierr = NF_INQ_VARID (nid, "emis", nvarid) 674 675 IF (ierr .NE. NF_NOERR) THEN 675 PRINT*, "lect_start_archive: Le champ <emis> est absent"676 PRINT*, "lect_start_archive: <emis> is missing" 676 677 CALL abort 677 678 ENDIF … … 682 683 #endif 683 684 IF (ierr .NE. NF_NOERR) THEN 684 PRINT*, "lect_start_archive: Lecture echouee pour<emis>"685 PRINT*, "lect_start_archive: Failed loading <emis>" 685 686 CALL abort 686 687 ENDIF … … 688 689 ierr = NF_INQ_VARID (nid, "ps", nvarid) 689 690 IF (ierr .NE. NF_NOERR) THEN 690 PRINT*, "lect_start_archive: Le champ <ps> est absent"691 PRINT*, "lect_start_archive: <ps> is missing" 691 692 CALL abort 692 693 ENDIF … … 697 698 #endif 698 699 IF (ierr .NE. NF_NOERR) THEN 699 PRINT*, "lect_start_archive: Lecture echouee pour<ps>"700 PRINT*, "lect_start_archive: Failed loading <ps>" 700 701 CALL abort 701 702 ENDIF … … 703 704 ierr = NF_INQ_VARID (nid, "tsurf", nvarid) 704 705 IF (ierr .NE. NF_NOERR) THEN 705 PRINT*, "lect_start_archive: Le champ <tsurf> est absent"706 PRINT*, "lect_start_archive: <tsurf> is missing" 706 707 CALL abort 707 708 ENDIF … … 712 713 #endif 713 714 IF (ierr .NE. NF_NOERR) THEN 714 PRINT*, "lect_start_archive: Lecture echouee pour<tsurf>"715 PRINT*, "lect_start_archive: Failed loading <tsurf>" 715 716 CALL abort 716 717 ENDIF … … 718 719 ierr = NF_INQ_VARID (nid, "q2surf", nvarid) 719 720 IF (ierr .NE. NF_NOERR) THEN 720 PRINT*, "lect_start_archive: Le champ <q2surf> est absent"721 PRINT*, "lect_start_archive: <q2surf> is missing" 721 722 CALL abort 722 723 ENDIF … … 727 728 #endif 728 729 IF (ierr .NE. NF_NOERR) THEN 729 PRINT*, "lect_start_archive: Lecture echouee pour<q2surf>"730 PRINT*, "lect_start_archive: Failed loading <q2surf>" 730 731 CALL abort 731 732 ENDIF … … 740 741 c ------------------------------------------- 741 742 ! Surface tracers: 742 do iq=1,nqmx 743 call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq)) 744 enddo 743 qsurfold(1:imold+1,1:jmold+1,1:nqmx)=0 745 744 746 745 DO iq=1,nqmx 747 ! iq=nqold748 ! write(str2,'(i2.2)') iq749 746 IF (oldtracernames) THEN 750 747 txt=" " … … 765 762 PRINT*, "lect_start_archive: ", 766 763 & " Tracer <",trim(txt),"> not found" 767 CALL abort 764 print*, "which (constant) value should it be initialized to?" 765 read(*,*) tmpval 766 qsurfold(1:imold+1,1:jmold+1,iq)=tmpval 768 767 ENDIF 769 768 #ifdef NC_DOUBLE … … 777 776 PRINT*, "lect_start_archive: ", 778 777 & " Failed loading <",trim(txt),">" 779 write (*,*) trim(txt),' set to 0' 780 call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq)) 778 print*, "which (constant) value should it be initialized to?" 779 read(*,*) tmpval 780 qsurfold(1:imold+1,1:jmold+1,iq)=tmpval 781 781 ENDIF 782 782 783 783 ENDDO ! of DO iq=1,nqmx 784 785 ! The trick below is to read in tracer nqmx-1 (i.e. water ice)786 ! if ((nqold.gt.1).and.(nqmx.gt.1)) then787 ! iq=nqold-1788 ! write(str2,'(i2.2)') iq789 ! ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)790 ! IF (ierr .NE. NF_NOERR) THEN791 ! PRINT*, "lect_start_archive:792 ! . Le champ <","qsurf"//str2,"> est absent"793 ! CALL abort794 ! ENDIF795 !#ifdef NC_DOUBLE796 ! ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,797 ! . qsurfold(1,1,nqmx-1))798 !#else799 ! ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,800 ! . qsurfold(1,1,nqmx-1))801 !#endif802 ! IF (ierr .NE. NF_NOERR) THEN803 ! PRINT*, "lect_start_archive:804 ! . Lecture echouee pour <","qsurf"//str2,">"805 ! write (*,*) 'qsurf'//str2,' set to 0'806 ! call initial0((jmold+1)*(imold+1), qsurfold(1,1,nqmx-1))807 ! ENDIF808 ! endif809 810 ! The trick below is to read in tracers except nqmx & nqmx-1 (water vap.& ice)811 ! if (nqold.gt.2) then812 ! do iq = 1, nqold-2813 ! if (iq.lt.nqmx-1) then814 ! write(str2,'(i2.2)') iq815 ! ierr = NF_INQ_VARID (nid, "qsurf"//str2, nvarid)816 ! IF (ierr .NE. NF_NOERR) THEN817 ! PRINT*, "lect_start_archive:818 ! . Le champ <","qsurf"//str2,"> est absent"819 ! CALL abort820 ! ENDIF821 !#ifdef NC_DOUBLE822 ! ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,823 ! . qsurfold(1,1,iq))824 !#else825 ! ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,826 ! . qsurfold(1,1,iq))827 !#endif828 ! IF (ierr .NE. NF_NOERR) THEN829 ! PRINT*, "lect_start_archive:830 ! . Lecture echouee pour <","qsurf"//str2,">"831 ! write (*,*) 'qsurf'//str2,' set to 0'832 ! call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))833 ! ENDIF834 ! end if835 ! end do836 ! end if837 784 838 785 !----------------------------------------------------------------------- … … 920 867 ierr = NF_INQ_VARID (nid,"temp", nvarid) 921 868 IF (ierr .NE. NF_NOERR) THEN 922 PRINT*, "lect_start_archive: Le champ <temp> est absent"869 PRINT*, "lect_start_archive: <temp> is missing" 923 870 CALL abort 924 871 ENDIF … … 929 876 #endif 930 877 IF (ierr .NE. NF_NOERR) THEN 931 PRINT*, "lect_start_archive: Lecture echouee pour<temp>"878 PRINT*, "lect_start_archive: Failed loading <temp>" 932 879 CALL abort 933 880 ENDIF … … 935 882 ierr = NF_INQ_VARID (nid,"u", nvarid) 936 883 IF (ierr .NE. NF_NOERR) THEN 937 PRINT*, "lect_start_archive: Le champ <u> est absent"884 PRINT*, "lect_start_archive: <u> is missing" 938 885 CALL abort 939 886 ENDIF … … 944 891 #endif 945 892 IF (ierr .NE. NF_NOERR) THEN 946 PRINT*, "lect_start_archive: Lecture echouee pour<u>"893 PRINT*, "lect_start_archive: Failed loading <u>" 947 894 CALL abort 948 895 ENDIF … … 950 897 ierr = NF_INQ_VARID (nid,"v", nvarid) 951 898 IF (ierr .NE. NF_NOERR) THEN 952 PRINT*, "lect_start_archive: Le champ <v> est absent"899 PRINT*, "lect_start_archive: <v> is missing" 953 900 CALL abort 954 901 ENDIF … … 959 906 #endif 960 907 IF (ierr .NE. NF_NOERR) THEN 961 PRINT*, "lect_start_archive: Lecture echouee pour<v>"908 PRINT*, "lect_start_archive: Failed loading <v>" 962 909 CALL abort 963 910 ENDIF … … 965 912 ierr = NF_INQ_VARID (nid,"q2atm", nvarid) 966 913 IF (ierr .NE. NF_NOERR) THEN 967 PRINT*, "lect_start_archive: Le champ <q2atm> est absent"914 PRINT*, "lect_start_archive: <q2atm> is missing" 968 915 CALL abort 969 916 ENDIF … … 974 921 #endif 975 922 IF (ierr .NE. NF_NOERR) THEN 976 PRINT*, "lect_start_archive: Lecture echouee pour<q2atm>"923 PRINT*, "lect_start_archive: Failed loading <q2atm>" 977 924 CALL abort 978 925 ENDIF … … 982 929 c the others keep their rank. ! No longer true. 983 930 c ------------------------------------------- 984 ! Tracers: 985 do iq=1,nqmx 986 call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) ) 987 enddo 931 ! Tracers: 932 qold(1:imold+1,1:jmold+1,1:lmold,1:nqmx)=0 988 933 989 934 DO iq=1,nqmx 990 ! iq=nqold991 ! write(str2,'(i2.2)') iq992 935 IF (oldtracernames) THEN 993 936 txt=" " … … 1001 944 PRINT*, "lect_start_archive: ", 1002 945 & " Tracer <",trim(txt),"> not found" 1003 CALL abort 946 print*, "which (constant) value should it be initialized to?" 947 read(*,*) tmpval 948 qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval 1004 949 ENDIF 1005 950 #ifdef NC_DOUBLE … … 1011 956 PRINT*, "lect_start_archive: ", 1012 957 & " Failed loading <",trim(txt),">" 1013 write (*,*) trim(txt),' set to 1.E-30' 1014 do l=1,lmold 1015 do j=1,jmold+1 1016 do i=1,imold+1 1017 qold(i,j,l,iq)=1.e-30 1018 end do 1019 end do 1020 end do 958 print*, "which (constant) value should it be initialized to?" 959 read(*,*) tmpval 960 qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval 1021 961 ENDIF 1022 962 1023 963 ENDDO ! of DO iq=1,nqmx 1024 964 1025 ! The trick below is to read in tracer nqmx-1 (i.e. water ice)1026 ! if ((nqold.gt.1).and.(nqmx.gt.1)) then1027 ! iq=nqold-11028 ! write(str2,'(i2.2)') iq1029 ! ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)1030 ! IF (ierr .NE. NF_NOERR) THEN1031 ! PRINT*, "lect_start_archive:1032 ! . Le champ <","q"//str2,"> est absent"1033 ! CALL abort1034 ! ENDIF1035 !#ifdef NC_DOUBLE1036 ! ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,1037 ! . qold(1,1,1,nqmx-1))1038 !#else1039 ! ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,1040 ! . qold(1,1,1,nqmx-1))1041 !#endif1042 ! IF (ierr .NE. NF_NOERR) THEN1043 ! PRINT*, "lect_start_archive:1044 ! . Lecture echouee pour <","q"//str2,">"1045 ! write (*,*) 'q'//str2,' set to 1.E-30'1046 ! do l=1,lmold1047 ! do j=1,jmold+11048 ! do i=1,imold+11049 ! qold(1,1,1,nqmx-1)=1.e-301050 ! end do1051 ! end do1052 ! end do1053 !1054 ! ENDIF1055 ! endif1056 1057 ! The trick below is to read in tracers except nqmx & nqmx-1 (water vap.& ice)1058 ! if (nqold.gt.2) then1059 ! do iq = 1, nqold-21060 ! if (iq.lt.nqmx-1) then1061 ! write(str2,'(i2.2)') iq1062 ! ierr = NF_INQ_VARID (nid, "q"//str2, nvarid)1063 ! IF (ierr .NE. NF_NOERR) THEN1064 ! PRINT*, "lect_start_archive:1065 ! . Le champ <","q"//str2,"> est absent"1066 ! CALL abort1067 ! ENDIF1068 !#ifdef NC_DOUBLE1069 ! ierr= NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))1070 !#else1071 ! ierr= NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))1072 !#endif1073 ! IF (ierr .NE. NF_NOERR) THEN1074 ! PRINT*, "lect_start_archive:1075 ! . Lecture echouee pour <","q"//str2,">"1076 ! write (*,*) 'q'//str2,' set to 1.E-30 '1077 ! do l=1,lmold1078 ! do j=1,jmold+11079 ! do i=1,imold+11080 ! qold(1,1,1,iq)=1.e-301081 ! end do1082 ! end do1083 ! end do1084 1085 ! ENDIF1086 ! end if1087 ! end do1088 ! end if1089 965 1090 966 c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...) … … 1157 1033 1158 1034 write(*,*) 1159 write(*,*)' Ancienne grille: masse de l atm:',ptotalold1160 write(*,*)'N ouvelle grille: masse de l atm:',ptotal1161 write (*,*) 'Ratio new atm ./ old atm =', ptotal/ptotalold1035 write(*,*)'Old grid: mass of the atmosphere :',ptotalold 1036 write(*,*)'New grid: mass of the atmosphere :',ptotal 1037 write (*,*) 'Ratio new atm / old atm =', ptotal/ptotalold 1162 1038 write(*,*) 1163 write(*,*)' Ancienne grille: masse de la glace CO2:',co2icetotalold1164 write(*,*)'N ouvelle grille: masse de la glace CO2:',co2icetotal1165 write(*,*)'Ratio new ice ./old ice =',co2icetotal/co2icetotalold1039 write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold 1040 write(*,*)'New grid: mass of CO2 ice:',co2icetotal 1041 write(*,*)'Ratio new ice / old ice =',co2icetotal/co2icetotalold 1166 1042 write(*,*) 1167 1043 … … 1263 1139 do j=1,jmold+1 1264 1140 ! copy values 1265 oldval(1)=tsurf S(i,j)1141 oldval(1)=tsurfold(i,j) 1266 1142 oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold) 1267 1143 ! build vertical coordinate … … 1295 1171 do j=1,jmold+1 1296 1172 ! copy values 1297 oldval(1)=tsurf S(i,j)1173 oldval(1)=tsurfold(i,j) 1298 1174 oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold) 1299 1175 ! interpolate
Note: See TracChangeset
for help on using the changeset viewer.